I have upgraded my AutoCAD 2002 to 2004, I was given a lisp routine for a snap to return the average point from any number of given points. (I got it of an Andrew Bichard when he wrote for Cad Desk magazine)
The thing is, it doesn't work with AutoCAD 2004 at all.
I was wondering if anyone here had either got it to work, or found something else that does the job as I used it all the time.
Andrew Bichard has not upgraded his ver yet, so has not looked at it.
Average is an additional AutoCAD snap mode. It prompts for a series of points, and then returns a single point, averaged from those entered. Select two points, and the mid point is returned. Select one end of a line twice and the other once. A point one third along is returned. Any point that can beexpressed as a ratio can be found this way, even say, eleven thirteenths. In addition you could select the corners of a triangle or rectangle to find the centre of gravity.
Average.lsp
1 (defun average ( / total new-pt count) 2 (setq total (getpoint "\nShow first point to average: ") 3 count 1) 4 (prompt "\n1 point so far,") 5 (while 6 (setq new-pt (getpoint " select another, or RETURN to end: ")) 7 (prompt 8 (strcat "\n" (itoa count) " points so far," ) 9 )
10 (setq total (mapcar '+ total new-pt)
11 count (1+ count))
12 )
13 (mapcar '(lambda (x) (/ x count)) total)
14 )
Menu call [Average](if (not average)(load "average"))(average)
The routine loops around the 'while' loop (lines 5 to 12) as long as valid points are entered in response to the 'getpoint' function. Each time around the loop, the X,Y and Z coordinates of the entered point are added to the existing total by the 'mapcar function on line 10, and the point count is incremented. When an invalid point is entered (a carriage return), the routine breaks out of the loop to line 13. This program line divides the total X, Y and Z coordinates by the number of points entered, and echoes the result to the calling AutoCAD command as a point. Note how in line 1, total, new-pt and count are declared as local variables so that they cannot interfere with any other loaded routines.
The menu call checks first to see if 'average' is defined, loading it if necessary. The routine is then called and runs. Average.lsp can be placed in your support subdirectory and called as shown by an additional line in your POP0 menu section. Unfortunately, due to restriction in AutoCAD, it cannot be used in response to another LISP routine.
Andrew Bichard andrew snipped-for-privacy@NOSPAMcompuserve.com (changed by me to stop spam)
Copyright Andrew Bichard 1996 ............... I hope this explains my problem better, I can't get this to work in AutoCAD
;|=========================================================== (MODES (A1)) MODE Store Stores modes for use by (MODER (A1) with variable name MODE-V as in (MODES '("BLIPMODE" "HIGHLIGHT")) used in (preset) add MODE-V to local variables DO NOT USE FOR READ ONLY VARIABLES OR MODER WILL CRASH ==============================================================|;
;|============================================================ (MODER) MODE Restore Used in (reset) to reset variables set by (MODES (A1)) ==============================================================|;
;|====================================================== (PRESET) and (RESET) RECORDS CURRENT SYSTEM VARIABLES and RESTORES If debug set T, all routines enter debug mode with full echo to screen If debug set nil, functions work normally old_error to local variables in calling routine ==========================================================|;
;| ;;;Useful function, Not currently used ;;;this was the definition of dxf that I used until recently. ;;;see read.me ;;; returns the first group value of an entity. ;;; like the wellknown (dxf) function but accepts all kinds of ;;; entity representations (ename, entget list, entsel list) ;;; NOTE: For getting 10 groups in LWPOLYLINE's not usable! (defun GETVAL (code ele) ;"dxf value" of any ent... (cond ((= (type ele) 'ENAME) ;ENAME (cdr (assoc code (entget ele)))) ((not ele) nil) ;empty value ((not (listp ele)) nil) ;invalid ele ((= (type (car ele)) 'ENAME) ;entsel-list (cdr (assoc code (entget (car ele))))) (T (cdr (assoc code ele))))) ;entget-list
|;
(PRINC ".") ;**************************************************************** ;* (round (num sig)) ;* rounds of num to sig figures ;****************************************************************
(DEFUN round (num sig) (ATOF (RTOS num 1 (1- sig))))
;**************************************************************** ;* (not0 (lst)) ;* used with dxflst to find non "0" value in list of layers ;* used in match and offlayer ;****************************************************************
(DEFUN not0 (lst / va) (WHILE (EQUAL (CAR lst) "0") (SETQ lst (CDR lst))) (IF lst (SETQ va (CAR lst)) (SETQ va "0") ) ;_ if ) ;_ defun
(PRINC ".")
;**************************************************************** ;* (DXFLST (code nent)) ;* returns assoc code matches for all nested entities as list ;* used in match and offlayer ;****************************************************************
(DEFUN dxflst (code nent / va vb) (SETQ va (LIST (dxf code (ENTGET (CAR nent)))) vb (CAR (REVERSE nent)) ) ;_ setq (WHILE (= (TYPE (CAR vb)) 'ename) (SETQ va (APPEND va (LIST (dxf code (ENTGET (CAR vb))))) vb (CDR vb) ) ;_ setq ) ;_ while (SETQ va va) ;returns value of VA to calling routine ) ;_ defun
(PRINC ".")
;**************************************************************** ;* (toasc (str)) ;* Converts str to string using itoa or rtos. ;****************************************************************
;**************************************************************** ;* (warn (strng)) ;* displays message as prompt or alert ;* depending on ACAD release and DEBUG state ;****************************************************************
;;;Revised definition of warn that always echoes to text screen (DEFUN warn (strng) (IF (AND ALERT (NULL debug)) (PROGN (PRINC);(princ) is a work-around for an R14 bug (ALERT strng) ) ) (PROMPT (STRCAT "\n" strng)) ) (PRINC ".")
;**************************************************************** ;* (ptom) ;* automatically changes focus to graphics screen ;* useful when debugging ;* offers to change to model space if paper space current ;****************************************************************
(DEFUN ptom () (GRAPHSCR) (IF (AND GETKWORD (= (GETVAR "CVPORT") 1) (= (GETVAR "TILEMODE") 0) ) (IF (confirm "Paper to Model" "Do you want to change to Model Space?" ) (COMMAND "._MSPACE") ) ;_ if ) ) ;;Remove ; to define PTOM as princ ;;this will disable PTOM function in all routines that use it
;(setq PTOM princ)
(PRINC ".")
;**************************************************************** ;* (mtop) ;* automatically changes focus to graphics screen ;* useful when debugging ;* offers to change to paper space if model space current anf TILEMODE=0 ;****************************************************************
(DEFUN mtop () (GRAPHSCR) (IF (AND GETKWORD (/= (GETVAR "CVPORT") 1) (= (GETVAR "TILEMODE") 0) ) (IF (confirm "Model to Paper" "Do you want to change to Paper Space?" ) (COMMAND "._PSPACE") ) ;_ if ) ) ;;Remove ; to define MTOP as princ ;;this will disable MTOP function in all routines that use it
;(setq MTOP princ)
(PRINC ".") ;**************************************************************** ;* (confirm (title string)) ;* asks for confirmation ;* and returns T or nil ;****************************************************************
;**************************************************************** ;* (mklay name colour linetype) ;* makes a layer if it does not already exist ;* uses (command "_.layer if R12 or earlier, otherwise entmake ;****************************************************************
PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here.
All logos and trade names are the property of their respective owners.