Search the Community
Showing results for tags 'lisp error'.
-
Lisp that was running stopped
nargothrond posted a topic in AutoCAD 2D Drafting, Object Properties & Interface
Good morning, how are you? I have a problem with a lisp that I was using since 2011. Until last week it was working normally, but this week lisp keeps returning this error: ** Error: no function definition: nil **. My autocad is 2016, it's on a laptop with windows 10. I tried some solutions: I reinstalled the program, reinstalled a newer version. All without success. So I tried it on my old desktop pc. It's autocad 2012, and Lisp ran normally. One more step: I installed 2018 and loaded the Lisp ... it worked normally. Now I do not know what else to do. Format the laptop? Is there anything else I can do? This is the LISP: ;;--------------------------=={ Dynamic Offset }==-----------------------------;; ;; ;; ;; Allows the user to dynamically offset multiple objects simultaneously, by ;; ;; either specifying the offset distance via mouse-click, or at the ;; ;; command-line. The command-line default will remember the last offset entered ;; ;; by the user. ;; ;; ;; ;; Object Snap functionality is retained, and the on-screen offset distance is ;; ;; determined by the nearest object in the offset selection set. ;; ;; ;; ;; The user can use the +/- keys to change the number of offsets, or, ;; ;; alternatively, the user can press 'N' and specify the number of offsets ;; ;; directly. ;; ;; ;; ;; The user can also press 'S' during object offset to change the layer, ;; ;; linetype, lineweight, and colour of the resultant offset objects. ;; ;; ;; ;; By pressing TAB the user can switch modes between offsetting both sides or ;; ;; just one side of an object. ;; ;; ;; ;; The toggle for retaining or deleting the original Objects can be altered by ;; ;; pressing 'D'. The user can hold SHIFT to highlight the offset entities. ;; ;; ;; ;;-------------------------------------------------------------------------------;; ;; ;; ;; FUNCTION SYNTAX: DynOff ;; ;; ;; ;;-------------------------------------------------------------------------------;; ;; ;; ;; Author: Lee Mac, Copyright © October 2009 - www.lee-mac.com ;; ;; ;; ;;-------------------------------------------------------------------------------;; ;; ;; ;; Version: ;; ;; ;; ;; 1.0: 17/10/2009 - First Release ;; ;;-------------------------------------------------------------------------------;; ;; 1.1: 19/10/2009 - Added Object Snap functionality ;; ;;-------------------------------------------------------------------------------;; ;; 1.2: 20/10/2009 - Added Multiple Offset Option ;; ;;-------------------------------------------------------------------------------;; ;; 1.3: 21/10/2009 - Updated Object Snap Coding ;; ;;-------------------------------------------------------------------------------;; ;; 1.4: 23/10/2009 - Updated Offset Number Options ;; ;; - Added option to specify Offset factor. ;; ;;-------------------------------------------------------------------------------;; ;; 1.5: 29/10/2009 - Added Settings Dialog. ;; ;;-------------------------------------------------------------------------------;; ;; 1.6: 08/12/2009 - Added option to only offset object on one side. ;; ;;-------------------------------------------------------------------------------;; ;; 1.7: 10/12/2009 - Added option to delete original objects. ;; ;;-------------------------------------------------------------------------------;; ;; 1.8: 14/12/2009 - Added ability to offset to the center of two objects. ;; ;;-------------------------------------------------------------------------------;; ;; 1.9: 16/12/2009 - Modified method for spacing multiple offsets. ;; ;; - Improved OSnap Coding. ;; ;;-------------------------------------------------------------------------------;; ;; 2.0: 18/12/2009 - Added colour change for offset entities. ;; ;; - Fixed Bug when using Offset Factor. ;; ;;-------------------------------------------------------------------------------;; ;; 2.1: 21/12/2009 - Updated code to check for Express Tools. ;; ;;-------------------------------------------------------------------------------;; (defun c:DynOff (/ ;; --=={ Local Functions }==-- *error* clean DynOff_Sub txt2num ;; --=={ Local Variables }==-- CODE CPT DATA DCFNAME DCTITLE DOC DRFT E1 E2 ELST ENTLST ET EXFLAG GR I IOBJ K MSG OBJ OBJLST OFF OOBJ OPT OSGRV OSTR PROP RLST SS X ;; --=={ Global Variables }==-- ; *dynOff ~ Default Offset Distance ; *dynNum ~ Default Offset Number ; *dynFac ~ Default Offset Factor ; *dynMod ~ Default Offset Mode (bit-coded) ; *dynDel ~ Default Delete Option ; *DynOffDefaults* ~ Default Dialog Settings ) (setq dcfname "LMAC_DynOff_V2.1.dcl" dcTitle "Dynamic Offset V2.1 Settings") (or *dynOff (setq *dynOff 10.0)) (or *dynNum (setq *dynNum 1 )) (or *dynFac (setq *dynFac 1.0)) (or *dynMod (setq *dynMod 2 )) (or *dynDel (setq *dynDel nil)) (or *DynOffDefaults* (setq *DynOffDefaults* '("1" "1" 256 256 "*Source*" "*Source*" ;; Layer "ByLayer" "ByLayer" ;; Linetype "ByLayer" "ByLayer"))) ;; Lineweight (setq k -1) (setq *DynOffDefaults* (mapcar (function (lambda (value) (cond ( (<= 4 (setq k (1+ k)) 5) (if (tblsearch "LAYER" value) value "*Source*")) ( (<= 6 k 7) (if (tblsearch "LTYPE" value) value "ByLayer")) (t value)))) *DynOffDefaults*)) (setq dynMode (nth *dynMod '(1 2 3))) ;; --=={ Error Handler }==-- (defun *error* (err) (setq eLst (clean eLst)) (and doc (vla-EndUndoMark doc)) (or (wcmatch (strcase err) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " err " **"))) (redraw) (princ)) ;;-------------------------------------------------------------------------------;; (defun clean (lst / lst) (cond (lst (mapcar (function (lambda (object) (if (not (vlax-erased-p object)) (vla-delete object)))) lst) (setq lst nil)))) (defun DynOff_Sub (obj off / rLst oObj iObj i) (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda ( ) (if (= 1 (logand 1 dynmode)) (progn (setq i 3 oObj (vlax-invoke obj 'Offset off)) (if (or (and et (not (acet-sys-shift-down))) (not et)) ;; -- Mod 2.0 -- (foreach prop '(color layer linetype lineweight) (mapcar (function (lambda (object / val) (if (or (vl-position (setq val (nth i *DynOffDefaults*)) '(256 "*Source*")) (and (= i 3) (= "1" (cadr *DynOffDefaults*)))) (vlax-put-property object prop (vlax-get-property obj prop)) (vlax-put-property object prop (if (< i 9) val (eval (read (strcat "acLnWt" val)))))))) oObj) (setq i (+ i 2)))))) (if (= 2 (logand 2 dynmode)) (progn (setq i 2 iObj (vlax-invoke obj 'Offset (- off))) (if (or (and et (not (acet-sys-shift-down))) (not et)) ;; -- Mod 2.0 -- (foreach prop '(color layer linetype lineweight) (mapcar (function (lambda (object / val) (if (or (vl-position (setq val (nth i *DynOffDefaults*)) '(256 "*Source*")) (and (= i 2) (= "1" (car *DynOffDefaults*)))) (vlax-put-property object prop (vlax-get-property obj prop)) (vlax-put-property object prop (if (< i 8) val (eval (read (strcat "acLnWt" val)))))))) iObj) (setq i (+ i 2)))))) (setq rLst (append oObj iObj)))))) (clean (append oObj iObj)) rLst)) (defun txt2num (txt) (cond ((distof txt 5)) ((distof txt 2)) ((distof txt 1)) ((distof txt 4)) ((distof txt 3)))) (defun GetOffLen (num fac / result) (setq result 0.) (while (not (minusp (setq num (1- num)))) (setq result (+ result (expt fac num)))) result) (setq et (not (vl-catch-all-error-p (vl-catch-all-apply (function (lambda nil (acet-sys-shift-down))))))) (or et (princ "\nExpress Tools not Loaded - Shift option not Available.")) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) drft (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))) osGrv (osmode-grvecs-lst (vla-get-AutoSnapMarkerColor drft) (vla-get-AutoSnapMarkerSize drft))) (cond ( (not (DC_Write dcfname)) (princ "\nDCL File could not be Written.")) (t (if (setq ss (ssget "_:L" '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))) (progn (vla-StartUndoMark doc) (setq ObjLst (mapcar 'vlax-ename->vla-object (setq EntLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))) oStr "") (setq msg '(strcat "\n[TAB] Mode, [+/-] Offset [N]umber, Offset [F]actor" "\n[C]enter, [S]ettings" (if et ", [SHIFT] Show Offsets" "") ", [D]elete Original = " (if *dynDel "Yes" "No") "\nSpecify Offset <" (vl-princ-to-string *dynOff) "> : ")) (princ (eval msg)) (while (progn (setq gr (grread 't 15 0) code (car gr) data (cadr gr)) (redraw) (cond ( (and (= 5 code) (listp data)) (setq EntLst (vl-sort EntLst (function (lambda (a b) (< (distance data (vlax-curve-getClosestPointto a data)) (distance data (vlax-curve-getClosestPointto b data))))))) (setq cPt (vlax-curve-getClosestPointto (car entLst) data) off (/ (distance cPt data) (GetOffLen *dynNum *dynFac))) ;; -- Mod 2.0 -- (grdraw cPt data 3 1) (setq eLst (clean eLst)) (if (and (< 0 (getvar "OSMODE") 16384) (setq oPt (vl-remove-if (function null) (mapcar (function (lambda (x / o) (if (setq o (osnap data x)) (list (distance data o) o x data)))) (get_osmode))))) (setq oPt (cdar (vl-sort oPt (function (lambda (a b) (< (car a) (car b))))))) (setq oPt nil)) (and oPt (OsMark oPt)) (foreach obj ObjLst (setq i -1 x 0.) (repeat *dynNum (setq eLst (append eLst (cond ((DynOff_Sub obj (* (setq x (+ x (expt *dynFac (setq i (1+ i))))) off))) ((clean eLst))))))) (if (and eLst et (acet-sys-shift-down)) (mapcar (function (lambda (x) (vla-put-color x acBlue))) eLst)) ;; -- Mod 2.0 -- t) ( (= code 25) nil) ( (and (= code 3) (listp data)) (clean eLst) (setq *dynOff off) (setq cPt (vlax-curve-getClosestPointto (car entLst) data)) (if (and (< 0 (getvar "OSMODE") 16384) (setq oPt (vl-remove-if (function null) (mapcar (function (lambda (x / o) (if (setq o (osnap data x)) (list (distance data o) o x data)))) (get_osmode))))) (setq oPt (cdar (vl-sort oPt (function (lambda (a b) (< (car a) (car b)))))) data (osnap (caddr oPt) (cadr oPt)) *dynOff (/ (distance (vlax-curve-getClosestPointto (car entLst) data) data) (GetOffLen *dynNum *dynFac))) ;; -- Mod 1.9 -- (setq oPt nil)) (foreach obj ObjLst (setq i -1 x 0.) (repeat *dynNum (setq eLst (append eLst (cond ((DynOff_Sub obj (* (setq x (+ x (expt *dynFac (setq i (1+ i))))) *dynoff))) ((clean eLst))))))) nil) ( (= code 2) (cond ( (or (= 46 data) (< 47 data 58)) (setq oStr (strcat oStr (chr data))) (princ (chr data))) ( (vl-position data '(67 99)) (clean eLst) (while (progn (setq e1 (entsel "\nSelect First Object: ")) (cond ( (vl-consp e1) (if (wcmatch (cdr (assoc 0 (entget (car e1)))) "ARC,CIRCLE,ELLIPSE,*LINE") (while (progn (setq e2 (car (entsel "\nSelect Second Object: "))) (cond ( (eq 'ENAME (type e2)) (if (wcmatch (cdr (assoc 0 (entget e2))) "ARC,CIRCLE,ELLIPSE,*LINE") (progn (setq p1 (vlax-curve-getClosestPointto (car e1) (cadr e1)) p2 (vlax-curve-getClosestPointto e2 p1)) (setq *dynOff (/ (distance p1 p2) (GetOffLen (1+ *dynNum) *dynFac))) ;; -- Mod 2.0 -- (foreach obj ObjLst (setq i -1 x 0.) (repeat *dynNum (setq eLst (append eLst (cond ( (DynOff_Sub obj (* (setq x (+ x (expt *dynFac (setq i (1+ i))))) *dynoff))) ( (clean eLst))))))) (setq exFlag nil)) (princ "\nInvalid Object Selected."))) ( (setq exFlag t) nil)))) (princ "\nInvalid Object Selected."))) ( (setq exFlag t) nil)))) exFlag) ( (vl-position data '(43 61)) (setq *dynNum (1+ *dynNum))) ( (vl-position data '(68 100)) (setq *dynDel (not *dynDel)) (princ (strcat "\nOriginal Objects " (if *dynDel "will" "will not") " be Deleted" (eval msg)))) ( (vl-position data '(78 110)) (initget 6) (setq *dynNum (cond ((getint (strcat "\nSpecify Number of Offsets <" (itoa *dynNum) "> : "))) (*dynNum))) (princ (eval msg))) ( (= data 6) (cond ( (< 0 (getvar "OSMODE") 16384) (setvar "OSMODE" (+ 16384 (getvar "OSMODE"))) (princ "\n<Osnap off>")) (t (setvar "OSMODE" (- (getvar "OSMODE") 16384)) (princ "\n<Osnap on>"))) (princ (eval msg))) ( (= data 9) (setq dynmode (cond ( (= 2 *dynMod) (setq *dynMod 0) 1) ( (nth (setq *dynMod (1+ *dynMod)) '(1 2 3)))))) ( (vl-position data '(70 102)) (initget 6) (setq *DynFac (cond ((getreal (strcat "\nSpecify Offset Factor <" (vl-princ-to-string *dynFac) "> : "))) (*dynFac))) (princ (eval msg))) ( (vl-position data '(83 115)) (Off_Settings dcfname (vlax-ename->vla-object (car EntLst))) t) ( (= data 45) (cond ( (= 1 *dynNum) (princ (strcat "\nMinimum Offset Number Reached." (eval msg)))) (t (setq *dynNum (1- *dynNum))))) ( (and (< 0 (strlen oStr)) (= data 8)) (setq oStr (substr oStr 1 (1- (strlen oStr)))) (princ (vl-list->string '(8 32 8)))) ( (vl-position data '(13 32)) (cond ( (zerop (strlen oStr)) (clean eLst) (foreach obj ObjLst (setq i -1 x 0.) (repeat *dynNum (setq eLst (append eLst (cond ( (DynOff_Sub obj (* (setq x (+ x (expt *dynFac (setq i (1+ i))))) *dynoff))) ( (clean eLst))))))) nil) ( (setq off (txt2num oStr)) (clean eLst) (setq *dynOff off) (foreach obj ObjLst (setq i -1 x 0.) (repeat *dynNum (setq eLst (append eLst (cond ( (DynOff_Sub obj (* (setq x (+ x (expt *dynFac (setq i (1+ i))))) off))) ( (clean eLst))))))) nil) (t (princ "\nInvalid Offset Entered.") (princ (eval msg)) (setq oStr "")))) (t ))) (t )))) (if *dynDel (mapcar (function vla-delete) ObjLst)) (vla-EndUndoMark doc))))) (princ)) (defun osMark (o / s) (setq s (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) o (cons (trans (car o) 1 3) (cdr o))) (grvecs (cdr (assoc (cadr o) osGrv)) (list (list s 0. 0. (caar o)) (list 0. s 0. (cadar o)) (list 0. 0. s 0.) (list 0. 0. 0. 1.)))) (defun get_osmode nil ; by Evgeniy Elpanov (mapcar (function cdr) (vl-remove-if (function (lambda (x) (zerop (logand (getvar "OSMODE") (car x))))) '((1 . "_end") (2 . "_mid") (4 . "_cen") (8 . "_nod") (16 . "_qua") (32 . "_int") (64 . "_ins") (128 . "_per") (256 . "_tan") (512 . "_nea") (2048 . "_app"))))) (defun osmode-grvecs-lst (col ass / -ASS ASS COL) ; By Evgeniy Elpanov (Modified by Lee Mac) (setq -ass (- ass)) (list (list "_end" col (list -ass -ass) (list -ass ass) col (list (1- -ass) (1- -ass)) (list (1- -ass) (1+ ass)) col (list -ass ass) (list ass ass) col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass)) col (list ass ass) (list ass -ass) col (list (1+ ass) (1+ ass)) (list (1+ ass) (1- -ass)) col (list ass -ass) (list -ass -ass) col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass))) (list "_mid" col (list -ass -ass) (list 0. ass) col (list (1- -ass) (1- -ass)) (list 0. (1+ ass)) col (list 0. ass) (list ass -ass) col (list 0. (1+ ass)) (list (1+ ass) (1- -ass)) col (list ass -ass) (list -ass -ass) col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass))) (list "_cen" 7 (list (* -ass 0.2) 0.) (list (* ass 0.2) 0.) 7 (list 0. (* -ass 0.2)) (list 0. (* ass 0.2)) col (list -ass 0.) (list (* -ass 0.86) (* ass 0.5)) col (list (* -ass 0.86) (* ass 0.5)) (list (* -ass 0.5) (* ass 0.86)) col (list (* -ass 0.5) (* ass 0.86)) (list 0. ass) col (list 0. ass) (list (* ass 0.5) (* ass 0.86)) col (list (* ass 0.5) (* ass 0.86)) (list (* ass 0.86) (* ass 0.5)) col (list (* ass 0.86) (* ass 0.5)) (list ass 0.) col (list ass 0.) (list (* ass 0.86) (* -ass 0.5)) col (list (* ass 0.86) (* -ass 0.5)) (list (* ass 0.5) (* -ass 0.86)) col (list (* ass 0.5) (* -ass 0.86)) (list 0. -ass) col (list 0. -ass)(list (* -ass 0.5) (* -ass 0.86)) col (list (* -ass 0.5) (* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5)) col (list (* -ass 0.86) (* -ass 0.5)) (list -ass 0.)) (list "_nod" col (list -ass -ass) (list ass ass) col (list -ass ass) (list ass -ass) col (list -ass 0.) (list (* -ass 0.86) (* ass 0.5)) col (list (* -ass 0.86) (* ass 0.5)) (list (* -ass 0.5) (* ass 0.86)) col (list (* -ass 0.5) (* ass 0.86)) (list 0. ass) col (list 0. ass) (list (* ass 0.5) (* ass 0.86)) col (list (* ass 0.5) (* ass 0.86)) (list (* ass 0.86) (* ass 0.5)) col (list (* ass 0.86) (* ass 0.5)) (list ass 0.) col (list ass 0.) (list (* ass 0.86) (* -ass 0.5)) col (list (* ass 0.86) (* -ass 0.5)) (list (* ass 0.5) (* -ass 0.86)) col (list (* ass 0.5) (* -ass 0.86)) (list 0. -ass) col (list 0. -ass)(list (* -ass 0.5) (* -ass 0.86)) col (list (* -ass 0.5) (* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5)) col (list (* -ass 0.86) (* -ass 0.5)) (list -ass 0.)) (list "_qua" col (list 0. -ass) (list -ass 0.) col (list 0. (1- -ass)) (list (1- -ass) 0.) col (list -ass 0.) (list 0. ass) col (list (1- -ass) 0.) (list 0. (1+ ass)) col (list 0. ass) (list ass 0.) col (list 0. (1+ ass)) (list (1+ ass) 0.) col (list ass 0.) (list 0. -ass) col (list (1+ ass) 0.) (list 0. (1- -ass))) (list "_int" col (list -ass -ass) (list ass ass) col (list -ass (1+ -ass)) (list ass (1+ ass)) col (list (1+ -ass) -ass) (list (1+ ass) ass) col (list -ass ass) (list ass -ass) col (list -ass (1+ ass)) (list ass (1+ -ass)) col (list (1+ -ass) ass) (list (1+ ass) -ass)) (list "_ins" col (list (* -ass 0.1) (* -ass 0.1)) (list -ass (* -ass 0.1)) col (list -ass (* -ass 0.1)) (list -ass ass) col (list -ass ass) (list (* ass 0.1) ass) col (list (* ass 0.1) ass) (list (* ass 0.1) (* ass 0.1)) col (list (* ass 0.1) (* ass 0.1)) (list ass (* ass 0.1)) col (list ass (* ass 0.1)) (list ass -ass) col (list ass -ass) (list (* -ass 0.1) -ass) col (list (* -ass 0.1) -ass) (list (* -ass 0.1) (* -ass 0.1)) col (list (1- (* -ass 0.1)) (1- (* -ass 0.1))) (list (1- -ass) (1- (* -ass 0.1))) col (list (1- -ass) (1- (* -ass 0.1))) (list (1- -ass) (1+ ass)) col (list (1- -ass) (1+ ass)) (list (1+ (* ass 0.1)) (1+ ass)) col (list (1+ (* ass 0.1)) (1+ ass)) (list (1+ (* ass 0.1)) (1+ (* ass 0.1))) col (list (1+ (* ass 0.1)) (1+ (* ass 0.1))) (list (1+ ass) (1+ (* ass 0.1))) col (list (1+ ass) (1+ (* ass 0.1))) (list (1+ ass) (1- -ass)) col (list (1+ ass) (1- -ass)) (list (1- (* -ass 0.1)) (1- -ass)) col (list (1- (* -ass 0.1)) (1- -ass)) (list (1- (* -ass 0.1)) (1- (* -ass 0.1)))) (list "_tan" col (list -ass ass) (list ass ass) col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass)) col (list -ass 0.) (list (* -ass 0.86) (* ass 0.5)) col (list (* -ass 0.86) (* ass 0.5)) (list (* -ass 0.5) (* ass 0.86)) col (list (* -ass 0.5) (* ass 0.86)) (list 0. ass) col (list 0. ass) (list (* ass 0.5) (* ass 0.86)) col (list (* ass 0.5) (* ass 0.86)) (list (* ass 0.86) (* ass 0.5)) col (list (* ass 0.86) (* ass 0.5)) (list ass 0.) col (list ass 0.) (list (* ass 0.86) (* -ass 0.5)) col (list (* ass 0.86) (* -ass 0.5)) (list (* ass 0.5) (* -ass 0.86)) col (list (* ass 0.5) (* -ass 0.86)) (list 0. -ass) col (list 0. -ass)(list (* -ass 0.5) (* -ass 0.86)) col (list (* -ass 0.5)(* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5)) col (list (* -ass 0.86)(* -ass 0.5)) (list -ass 0.)) (list "_per" col (list -ass -ass) (list -ass ass) col (list (1- -ass) (1- -ass)) (list (1- -ass) (1+ ass)) col (list ass -ass) (list -ass -ass) col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass)) col (list -ass 0.) (list 0. 0.) col (list -ass -1.) (list 0. -1.) col (list 0. 0.) (list 0. -ass) col (list -1. 0.) (list -1. -ass)) (list "_nea" col (list -ass -ass) (list ass ass) col (list -ass ass) (list ass ass) col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass)) col (list -ass ass) (list ass -ass) col (list ass -ass) (list -ass -ass) col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass))) (list "_app" col (list -ass -ass) (list ass ass) col (list ass -ass) (list -ass ass) col (list -ass -ass) (list -ass ass) col (list (1- -ass) (1- -ass)) (list (1- -ass) (1+ ass)) col (list -ass ass) (list ass ass) col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass)) col (list ass ass) (list ass -ass) col (list (1+ ass) (1+ ass)) (list (1+ ass) (1- -ass)) col (list ass -ass) (list -ass -ass) col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass))))) ;; ----=={ DCL Section }==---- (defun Off_Settings (fname obj / mklst img layCol mk_arc lays dcTag lLay lLin bsCol bsflag) (mapcar 'set '(*dyniCols *dynoCols *dyniCol *dynoCol *dynilay *dynolay *dynilin *dynolin *dyniwgt *dynowgt) *DynOffDefaults*) (defun mklst (key lst) (start_list key) (mapcar 'add_list lst) (end_list)) (defun img (key col) (start_image key) (fill_image 0 0 (dimx_tile key) (dimy_tile key) col) (end_image)) (setq doc (cond (doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))) lays (vla-get-layers doc)) (defun layCol (lay) (vla-get-color (vla-item lays lay))) (setq bsCol (cond ( (vl-position (setq bsCol (vla-get-Color obj)) '(256 0)) (setq bsflag t) (layCol (vla-get-Layer obj))) (bsCol))) (defun mk_arc nil (vec_arc (if (= "1" *dyniCols) (if bsFlag (laycol (if (eq "*Source*" *dynilay) (vla-get-layer obj) *dynilay)) bsCol) (if (= 256 *dyniCol) (if (eq "*Source*" *dynilay) bsCol (laycol *dynilay)) *dyniCol)) bsCol (if (= "1" *dynoCols) (if bsFlag (laycol (if (eq "*Source*" *dynolay) (vla-get-layer obj) *dynolay)) bsCol) (if (= 256 *dynoCol) (if (eq "*Source*" *dynolay) bsCol (laycol *dynolay)) *dynoCol)))) (cond ( (<= (setq dcTag (load_dialog fname)) 0) (princ "\nDialog File not Found.")) ( (not (new_dialog "dsett" dcTag)) (princ "\nSettings Dialog could not be Loaded.")) (t (vlax-for lay (vla-get-layers doc) (setq lLay (cons (vla-get-Name lay) lLay))) (setq lLay (cons "*Source*" (acad_strlsort lLay))) (vlax-for lin (vla-get-linetypes doc) (setq lLin (cons (vla-get-Name lin) lLin))) (setq lLin (append '("*Source*" "ByLayer") (acad_strlsort (cddr (reverse lLin))))) (setq lWgt '("*Source*" "ByLayer" "000" "005" "009" "013" "015" "018" "020" "025" "030" "035" "040" "050" "053" "060" "070" "080" "090" "100" "106" "120" "140" "158" "200" "211")) (mapcar 'mklst '("ilay" "olay" "ilin" "olin" "olw" "ilw") (list lLay lLay lLin lLin lWgt lWgt)) (mapcar 'set_tile '("ilay" "olay" "ilin" "olin" "ilw" "olw") (mapcar 'itoa (mapcar 'vl-position (list *dyniLay *dynoLay *dyniLin *dynoLin *dyniWgt *dynoWgt) (list lLay lLay lLin lLin lWgt lWgt)))) (set_tile "icols" *dyniCols) (set_tile "ocols" *dynoCols) (set_tile "dtitle" dcTitle) (mode_tile "icol" (atoi (get_tile "icols"))) (mode_tile "ocol" (atoi (get_tile "ocols"))) (logo) (mk_arc) (mapcar 'img '("icol" "ocol") (list *dyniCol *dynoCol)) (action_tile "ilay" (vl-prin1-to-string (quote (progn (setq *dynilay (nth (atoi $value) lLay)) (mk_arc))))) (action_tile "olay" (vl-prin1-to-string (quote (progn (setq *dynolay (nth (atoi $value) lLay)) (mk_arc))))) (action_tile "ilin" (vl-prin1-to-string (quote (progn (setq *dyniLin (nth (atoi $value) lLin)))))) (action_tile "olin" (vl-prin1-to-string (quote (progn (setq *dynoLin (nth (atoi $value) lLin)))))) (action_tile "ilw" (vl-prin1-to-string (quote (progn (setq *dyniWgt (nth (atoi $value) lWgt)))))) (action_tile "olw" (vl-prin1-to-string (quote (progn (setq *dynoWgt (nth (atoi $value) lWgt)))))) (action_tile "icol" (vl-prin1-to-string (quote (progn (setq *dyniCol (cond ((acad_colordlg *dyniCol)) (*dyniCol))) (img "icol" *dyniCol) (mk_arc))))) (action_tile "ocol" (vl-prin1-to-string (quote (progn (setq *dynoCol (cond ((acad_colordlg *dynoCol)) (*dynoCol))) (img "ocol" *dynoCol) (mk_arc))))) (action_tile "icols" (vl-prin1-to-string (quote (progn (mode_tile "icol" (atoi (setq *dyniCols $value))) (mk_arc))))) (action_tile "ocols" (vl-prin1-to-string (quote (progn (mode_tile "ocol" (atoi (setq *dynoCols $value))) (mk_arc))))) (action_tile "accept" (vl-prin1-to-string (quote (progn (setq *DynOffDefaults* (list *dyniCols *dynoCols *dyniCol *dynoCol *dynilay *dynolay *dynilin *dynolin *dyniwgt *dynowgt)) (done_dialog))))) (action_tile "cancel" "(done_dialog)") (start_dialog) (unload_dialog dcTag)))) (defun DC_Write (fname / wPath ofile) (if (not (findfile fname)) (if (setq wPath (findfile "ACAD.PAT")) (progn (setq wPath (vl-filename-directory wPath)) (or (eq "\\" (substr wPath (strlen wPath))) (setq wPath (strcat wPath "\\"))) (setq ofile (open (strcat wPath fname) "w")) (foreach str '( "//-------------------=={ Dynamic Offset }==-------------------//" "// //" "// DynOff.dcl for use in conjunction with DynOff.lsp //" "//------------------------------------------------------------//" "// Author: Lee Mac, Copyright © 2009 - www.lee-mac.com //" "//------------------------------------------------------------//" "" "// Sub-Assembly Definitions" "" "pop : popup_list { fixed_width = false; alignment = centered; }" "col : image_button { alignment = centered; height = 1.5; width = 4.0;" " fixed_width = true; fixed_height = true; color = 2; }" "" "// Main Dialog" "" "dsett : dialog { key = \"dtitle\";" " spacer;" " : row {" " : boxed_column { label = \"Offset Preview\"; fixed_width = false; " " : boxed_row { label = \"Outer Colour\"; fixed_width = true;" " alignment = centered;" " spacer;" " : col { key = \"ocol\"; }" " spacer;" " : toggle { key = \"ocols\"; label = \"Source\"; }" " spacer;" " } // boxed_row" " : image { key = \"dimage\"; alignment = centered;" " width = 24.64 ; fixed_width = true;" " height = 11.39; fixed_height = true; color = -2; }" " : boxed_row { label = \"Inner Colour\"; fixed_width = true;" " alignment = centered;" " spacer;" " : col { key = \"icol\"; }" " spacer;" " : toggle { key = \"icols\"; label = \"Source\"; }" " spacer;" " } // boxed_row" " } // column" " : column { " " : boxed_column { label = \"Outer Offset\";" " : pop { label = \"Layer:\"; key = \"olay\"; }" " : pop { label = \"Linetype:\"; key = \"olin\"; }" " : pop { label = \"Lineweight:\"; key = \"olw\" ; }" " spacer;" " } // boxed_column" " spacer;" " : boxed_column { label = \"Inner Offset\";" " : pop { label = \"Layer:\"; key = \"ilay\"; }" " : pop { label = \"Linetype:\"; key = \"ilin\"; }" " : pop { label = \"Lineweight:\"; key = \"ilw\" ; }" " spacer;" " } // boxed_column" " } // column" " } // row" " spacer;" " : row {" " : spacer { width = 19.33; height = 3.18; }" " ok_cancel;" " spacer;" " : image { key = \"logo\" ; alignment = centered;" " width = 19.33; fixed_width = true;" " height = 3.18; fixed_height = true; color = -15; }" " } // row" "} // dialog" "" "//------------------------------------------------------------//" "// End of File //" "//------------------------------------------------------------//" ) (write-line str ofile)) (close ofile) t) nil) t)) (defun logo nil (start_image "logo") (mapcar 'vector_image '(24 21 19 18 17 16 15 14 1 1 0 0 17 8 0 0 1 1 1 1 8 8 7 7 7 7 7 7 33 33 35 37 38 39 41 48 47 46 46 54 52 51 50 49 41 42 43 44 45 46 46 47 47 48 48 48 48 48 49 49 49 49 48 48 48 47 47 44 46 47 48 49 49 50 50 51 52 52 53 53 53 53 53 53 53 52 52 52 52 51 51 51 51 52 54 54 55 56 58 59 60 62 70 70 68 67 65 64 62 61 59 58 57 55 64 63 63 63 63 62 61 71 70 69 69 69 69 69 68 69 69 69 47 26 27 28 28 28 28 28 27 27 26 25 36 34 33 33 33 46 46 47 77 77 77 76 75 74 73 73 73 72 72 72 72 72 72 72 72 73 73 74 75 79 76 76 76 75 75 75 75 75 76 76 76 77 77 78 78 79 80 81 83 84 85 86 93 76 77 87 87 81 80 88 88 88 88 86 86 94 93 92 92 92 92 92 92 93 113 113 112 111 109 108 107 105 109 111 112 113 113 113 96 94 93 93 93 93 93 94 95 96 97 98 99 101 102 104 105 107 108 104 103 101 100 100 99 99 98 98 98 98 98 99 100 102 103 104 101 99 98 96 94 105 107 108 109 110 112 113 114 114 114 112 111 110 108 107 105 103 102) '(16 18 19 20 21 21 21 21 22 23 23 24 24 0 0 0 1 2 3 21 21 21 20 19 18 1 1 0 1 1 2 2 3 4 5 5 4 3 3 1 1 2 3 4 5 6 7 9 10 12 12 13 15 16 18 19 21 23 25 25 27 28 30 31 33 34 35 40 38 37 36 34 34 33 31 30 28 28 26 25 23 21 21 19 18 16 15 14 13 11 10 10 9 8 7 6 5 4 3 3 2 2 0 0 0 0 0 0 0 0 0 0 0 0 1 20 21 22 22 23 24 24 23 23 22 21 20 4 3 2 2 0 0 0 1 2 2 4 4 20 21 23 23 24 24 23 22 21 20 1 1 0 4 5 6 7 8 9 11 12 13 15 16 18 20 20 22 23 25 26 27 29 30 34 30 29 27 26 24 22 21 19 18 16 15 13 12 12 10 9 8 7 6 5 4 4 3 3 3 4 10 10 12 12 19 19 20 21 22 22 21 21 20 19 6 6 5 3 13 14 15 16 17 18 19 19 20 19 18 17 15 14 5 9 11 12 14 14 16 17 18 19 20 21 21 22 22 22 22 21 21 20 19 19 18 18 17 16 14 12 11 10 8 7 6 6 5 5 3 3 3 3 3 5 5 6 6 6 7 7 7 7 6 5 4 4 3 3 3 3 3) '(21 19 18 17 16 15 14 8 1 0 0 17 24 0 0 1 1 1 1 1 8 7 7 7 7 7 7 8 33 35 37 38 39 41 41 47 46 46 46 52 51 50 49 48 42 43 44 45 46 46 47 47 48 48 48 48 48 49 49 49 49 48 48 48 47 47 44 46 47 48 49 49 50 50 51 52 52 53 53 53 53 53 53 53 52 52 52 52 51 51 51 51 52 54 54 55 56 58 59 60 62 64 70 68 67 65 64 62 61 59 58 57 55 54 63 63 63 63 62 61 71 70 69 69 69 69 69 68 69 69 69 70 26 27 28 28 28 28 28 27 27 26 25 36 34 33 33 33 33 46 47 47 77 77 76 75 74 73 73 73 72 72 72 72 72 72 72 72 73 73 74 75 79 76 76 76 75 75 75 75 75 76 76 76 77 77 78 78 79 80 81 83 84 85 86 87 76 77 77 87 81 80 88 88 88 88 86 86 94 93 92 92 92 92 92 92 93 93 113 112 111 109 108 107 105 104 111 112 113 113 113 113 94 93 93 93 93 93 94 95 96 97 98 99 101 102 104 105 107 108 109 103 101 100 100 99 99 98 98 98 98 98 99 100 102 103 104 105 99 98 96 94 96 107 108 109 110 112 113 114 114 114 112 111 110 108 107 105 103 102 101) '(18 19 20 21 21 21 21 21 23 23 24 24 16 0 0 1 2 3 21 22 21 20 19 18 1 1 0 0 1 2 2 3 4 5 5 4 3 3 1 1 2 3 4 5 6 7 9 10 12 12 13 15 16 18 19 21 23 25 25 27 28 30 31 33 34 35 40 38 37 36 34 34 33 31 30 28 28 26 25 23 21 21 19 18 16 15 14 13 11 10 10 9 8 7 6 5 4 3 3 2 2 1 0 0 0 0 0 0 0 0 0 0 0 1 20 21 22 22 23 24 24 23 23 22 21 20 4 3 2 2 0 0 0 1 2 2 4 4 20 21 23 23 24 24 23 22 21 20 1 1 0 0 5 6 7 8 9 11 12 13 15 16 18 20 20 22 23 25 26 27 29 30 34 30 29 27 26 24 22 21 19 18 16 15 13 12 12 10 9 8 7 6 5 4 4 4 3 3 4 10 10 12 12 19 19 20 21 22 22 21 21 20 19 6 6 5 3 3 14 15 16 17 18 19 19 20 19 18 17 15 14 13 9 11 12 14 14 16 17 18 19 20 21 21 22 22 22 22 21 21 20 19 19 18 18 17 16 14 12 11 10 8 7 6 6 5 5 5 3 3 3 3 5 5 6 6 6 7 7 7 7 6 5 4 4 3 3 3 3 3 3) '(14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 14 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166 166)) (end_image)) (defun vec_arc (iCol bCol oCol) (start_image "dimage") (mapcar 'vector_image '(0 48 48 48 48 47 46 45 44 43 42 40 39 37 35 33 31 29 26 24 21 19 16 14 11 8 5 2) '(0 146 143 141 138 135 132 130 127 124 122 119 117 115 113 111 109 107 105 104 103 101 100 99 99 98 98 97) '(0 48 48 48 47 46 45 44 43 42 40 39 37 35 33 31 29 26 24 21 19 16 14 11 8 5 2 0) '(0 143 141 138 135 132 130 127 124 122 119 117 115 113 111 109 107 105 104 103 101 100 99 99 98 98 97 97) (list iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol iCol)) (mapcar 'vector_image '(0 42 39 35 32 28 25 21 18 14 10 7 3 42 39 35 32 28 25 21 18 14 10 7 3 71 69 66 63 60 58 55 52 48 45 71 69 66 63 60 58 55 52 48 45 93 92 90 89 88 86 84 82 80 78 76 74 93 92 90 89 88 86 84 82 80 78 76 74 97 97 97 97 96 96 95 94 97 97 97 97 96 96 95 94) '(0 58 57 55 54 53 52 51 50 50 49 49 49 58 57 55 54 53 52 51 50 50 49 49 49 80 77 75 72 70 68 65 63 62 60 80 77 75 72 70 68 65 63 62 60 117 114 111 107 104 101 97 94 91 88 85 82 117 114 111 107 104 101 97 94 91 88 85 82 146 143 139 135 132 128 125 121 146 143 139 135 132 128 125 121) '(0 39 35 32 28 25 21 18 14 10 7 3 0 39 35 32 28 25 21 18 14 10 7 3 0 69 66 63 60 58 55 52 48 45 42 69 66 63 60 58 55 52 48 45 42 92 90 89 88 86 84 82 80 78 76 74 71 92 90 89 88 86 84 82 80 78 76 74 71 97 97 97 96 96 95 94 93 97 97 97 96 96 95 94 93) '(0 57 55 54 53 52 51 50 50 49 49 49 48 57 55 54 53 52 51 50 50 49 49 49 48 77 75 72 70 68 65 63 62 60 58 77 75 72 70 68 65 63 62 60 58 114 111 107 104 101 97 94 91 88 85 82 80 114 111 107 104 101 97 94 91 88 85 82 80 143 139 135 132 128 125 121 117 143 139 135 132 128 125 121 117) (list bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol bCol)) (mapcar 'vector_image '(56 51 47 43 39 35 30 26 22 17 13 8 4 0 106 103 100 97 93 90 86 83 79 75 72 68 64 60 146 146 146 146 145 144 144 143 142 141 139 138 137 135 133 131 129 127 125 123 120 118 115 112 109) '(11 9 8 6 5 4 3 2 1 1 0 0 0 0 46 42 39 36 34 31 28 25 23 21 18 16 14 12 146 142 137 133 129 124 120 115 111 107 103 98 94 90 86 82 78 74 70 67 63 59 56 52 49) '(51 47 43 39 35 30 26 22 17 13 8 4 0 0 103 100 97 93 90 86 83 79 75 72 68 64 60 56 146 146 146 145 144 144 143 142 141 139 138 137 135 133 131 129 127 125 123 120 118 115 112 109 106) '(9 8 6 5 4 3 2 1 1 0 0 0 0 0 42 39 36 34 31 28 25 23 21 18 16 14 12 11 142 137 133 129 124 120 115 111 107 103 98 94 90 86 82 78 74 70 67 63 59 56 52 49 46) (list oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol oCol)) (end_image)) (vl-load-com) (princ "\n:: DynOff.lsp | Version 2.1 | © Lee Mac 2009 www.lee-mac.com ::") (princ "\n:: Type \"DynOff\" to Invoke ::") (princ) ;;-------------------------------------------------------------------------------;; ;; End of File ;; ;;-------------------------------------------------------------------------------;; Thank you all!! dynoffv2-1.lsp -
Dear Masters, what is the wrong in my lisp program.please find error message while using the code. kindly fix the error. ;___________________________________________________________________________________________________________ ; ; Function to export a the coordinates of a group of points to excel (using csv file method) ;___________________________________________________________________________________________________________ (defun C:MirrorPoints (/ lstOfPoints lstSelections ssSelections strCSVFullName) (if (and (setq ssSelections (ssget "x" (list (cons 0 "POINT")))) (setq lstSelections (selectionsettolist ssSelections)) (setq lstOfPoints (mapcar '(lambda (X)(vlax-get X "coordinates")) lstSelections)) (setq lstOfPoints (mapcar (quote (lambda (X)(mapcar '* (list 1 -1 1) X))) lstOfPoints));<- Mirrored about X-X (setq lstOfPoints (mapcar (quote (lambda (X)(mapcar '+ (list 0 3000 0) X))) lstOfPoints));<- add 3000 to Y coordinate (setq lstOfPoints (cons (list "X" "Y" "Z") lstOfPoints)) (setq strCSVFullName (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".csv")) ) (progn (while (vl-string-search " " strCSVFullName)(setq strCSVFullName (vl-string-subst "" " " strCSVFullName))) ;Startapp doesn't like spaces (ListToCSVFile strCSVFullName lstOfPoints ",") (startapp "C:\\Program Files (x86)\\Microsoft Office\\Office12\\EXCEL.EXE" strCSVFullName) ) ) ) ;___________________________________________________________________________________________________________ ; ; Function to convert a entity based selection set to a list. ;___________________________________________________________________________________________________________ (defun SelectionSetToList (ssSelections / entSelection intCount lstObjects objSelection ) (repeat (setq intCount (sslength ssSelections)) (setq intCount (1- intCount)) (setq entSelection (ssname ssSelections intCount)) (setq objSelection (vlax-ename->vla-object entSelection)) (setq lstObjects (cons objSelection lstObjects)) ) (reverse lstObjects) ) ;___________________________________________________________________________________________________________ ; ; Export a list of sublists of to a text file ;___________________________________________________________________________________________________________ (defun ListToCSVFile (strFilename lstOfSublists strChar / strText strText2 filData lstSublist) (setq filData (open strFileName "w")) (close filData) (setq filData (open strFileName "w")) (foreach lstSubList lstOfSublists (setq strText (vl-princ-to-string (nth 0 lstSubList))) (if (and (= (type (cdr lstSublist)) 'LIST) (> (length lstSublist) 1) ) (foreach strText2 (cdr lstSubList) (setq strText (strcat strText strChar (vl-princ-to-string strText2))) ) (if (cdr lstSublist) (setq strText (strcat strText strChar (vl-princ-to-string (cdr lstSubList)))) ) ) (write-line strText filData) ) (close filData) (prin1) ) (vl-load-com) Thank you, with best regards.
-
Differences in Dimention and Coordinate points
pvsvprasad posted a topic in AutoLISP, Visual LISP & DCL
Dear Masters, i have one lisp for exporting points. and i have cross checked in excel values differences and auto cad dimension.i observed many points with 0.01m differences. for example in auto cad drawing showing 1.71m, but by excel coordinate difference is 1.72. why it is showing 0.01m difference. please find my lisp and make a modification to produce exact points with nil differences. ;; Write CSV - Lee Mac ;; Writes a matrix list of cell values to a CSV file. ;; lst - [lst] list of lists, sublist is row of cell values ;; csv - [str] filename of CSV file to write ;; Returns T if successful, else nil (defun LM:writecsv ( lst csv / des sep ) (if (setq des (open csv "w")) (progn (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (","))) (foreach row lst (write-line (LM:lst->csv row sep) des)) (close des) t ) ) ) ;; List -> CSV - Lee Mac ;; Concatenates a row of cell values to be written to a CSV file. ;; lst - [lst] list containing row of CSV cell values ;; sep - [str] CSV separator token (defun LM:lst->csv ( lst sep ) (if (cdr lst) (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep)) (LM:csv-addquotes (car lst) sep) ) ) (defun LM:csv-addquotes ( str sep / pos ) (cond ( (wcmatch str (strcat "*[`" sep "\"]*")) (setq pos 0) (while (setq pos (vl-string-position 34 str pos)) (setq str (vl-string-subst "\"\"" "\"" str pos) pos (+ pos 2) ) ) (strcat "\"" str "\"") ) ( str ) ) ) ;; gc:distinct (gilles chanteau) ;; Suprime tous les doublons d'une liste ;; ;; Argument ;; l : une liste (defun gc:distinct (l) (if l (cons (car l) (gc:distinct (vl-remove (car l) l))) ) ) (defun l-coor2l-pt (lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst)) (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) ) ) (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (defun c:ptdef2notepad ( / js dxf_cod mod_sel n lremov str_sep oldim ename l_pt l_pr pr l_x l_y tmp1 f_openx tmp2 f_openy) (princ "\nSelect model object for filtering: ") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "*LINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nIsn't an available object!") ) (vl-load-com) (setq dxf_cod (entget (ssname js 0))) (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) (initget "Single All Manual") (if (eq (setq mod_sel (getkword "\nSelect mode, [single/All/Manual]<Manual>: ")) "Single") (setq n -1) (if (eq mod_sel "All") (setq js (ssget "_X" dxf_cod) n -1) (setq js (ssget dxf_cod) n -1) ) ) (setq str_sep " " ;-> **** YOU CAN CHANGE THIS STRING BY WHAT YOU WONT ! **** <- oldim (getvar "dimzin") ) (setvar "dimzin" 0) (repeat (sslength js) (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n))))) (setq l_pr (list 'StartPoint 'EndPoint 'Center 'InsertionPoint 'Coordinates 'FitPoints)) (foreach pr l_pr (if (vlax-property-available-p ename pr) (setq l_pt (if (or (eq pr 'Coordinates) (eq pr 'FitPoints)) (append (if (eq (vla-get-ObjectName ename) "AcDbPolyline") (l-coor2l-pt (vlax-get ename pr) nil) (if (and (eq pr 'FitPoints) (zerop (vlax-get ename 'FitTolerance))) (l-coor2l-pt (vlax-get ename 'ControlPoints) T) (l-coor2l-pt (vlax-get ename pr) T) ) ) l_pt ) (append (l-coor2l-pt (vlax-get ename pr) T) l_pt) ) ) ) ) ) (setq l_x (gc:distinct (mapcar '(lambda (x) (rtos (/ x 1.0) 2 2)) (vl-sort (mapcar 'car l_pt) '<)))) ;-> **** YOU CAN CHANGE UNIT AND PREC (rtos x unit prec) ! **** <- (setq l_y (gc:distinct (mapcar '(lambda (x) (rtos (/ x 1.0) 2 2)) (vl-sort (mapcar 'cadr l_pt) '<)))) ;-> **** YOU CAN CHANGE UNIT AND PREC (rtos x unit prec) ! **** < (cond ( (< (length l_x) (length l_y)) (while (< (length l_x) (length l_y)) (setq l_x (append l_x '(""))) ) ;_ >while ) ( (> (length l_x) (length l_y)) (while (> (length l_x) (length l_y)) (setq l_y (append l_y '(""))) ) ;_ >while ) ) ;_ >cond (setq l_x (append '("x") l_x) l_y (append '("y ") l_y) ) ;_ >setq (setq fn (getfiled "Create Output File" "" "csv" 1)) (if (LM:WriteCSV (mapcar '(lambda (x y) (list x y))l_x l_y) fn) (startapp "explorer" fn) ) ;;; (setq ;;; tmp1 (vl-filename-mktemp "tmp_x.csv") ;;; f_openx (open tmp1 "w") ;;; ) ;;; (mapcar '(lambda (x) (write-line x f_openx)) l_x) ;;; ;(write-line (apply 'strcat (mapcar '(lambda (x) (strcat x str_sep)) l_x)) f_openx) ;;; (close f_openx) ;;; (startapp "notepad" tmp1) ;;; (setq ;;; tmp2 (vl-filename-mktemp "tmp_y.csv") ;;; f_openy (open tmp2 "w") ;;; ) ;;; (mapcar '(lambda (y) (write-line y f_openy)) l_y) ;;; ;(write-line (apply 'strcat (mapcar '(lambda (x) (strcat x str_sep)) l_y)) f_openy) ;;; (close f_openy) (startapp "notepad" tmp2) (setvar "dimzin" oldim) (prin1) ) please find sample drawing and output values excel file. Error is 0.01.dwg error 0.01.xlsx -
Hello, I am new in coding lisp files. I worked with vb.net so this is very strange for me at this moment . I want to to select two points with different coordinates and to calculate difference between Z. I want to label that difference and to draw line with specific length under text. I did some coding which I pasted below but it wont draw line. I think that somehow I can not create pt2 and use it. Please help me because my head will blow... Code is below... THANKS (defun c:raz ( / p textloc p1 p2) (vl-load-com) (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq p (getpoint "Odaberite tacku terena: ")) (setq zt (rtos (caddr p))) (setq pomocni 1) (setq p5 (getpoint "Odaberite tacku toplovoda: ")) (setq zc (rtos (caddr p5))) (setq p1 (getpoint "\nOdaberi poziciju teksta.")) (setq y (rtos (car p1))) (setq x (rtos (cadr p1))) (setq z (rtos (caddr p1))) (setq thetext (vla-AddText mspace zt (vlax-3d-point (car p1) (cadr p1) [lz] ) "0.65")) (setq TTT (atof(cadr p1))) (setq p2 (list (+ TTT 2.24) (cadr p1) (caddr p1))) (setq YY (- x pomocni)) (command "Line" p1 p2 "") )
- 15 replies
-
- length
- help with lisp
-
(and 2 more)
Tagged with:
-
Hi, I have started to write a routine and it models what I wanted so far, except the last entity set to "HdrFtr". When I try to list data on "HdrFtr" I get this ... h *1410(1 |") (1 . "/061+ {rn rn {rn mhjqggjgoglifmkii rmmfqiimmfmokolgjjj nqj |") (1 . "/061+ {rn rn {rn mhjqggjgogligjmghl rmmiqnimmfmnkginmin nqj |") (1 . "1>2:@>++-6=r8:1r>++-6= {rn rn {rn {rn {lg 30,: 30,: >//3& ,(::/@:1;@9>1:r,*-9>Instead of this..... ((-1 . ) (0 . "LWPOLYLINE") (330 . ) (5 . "1AF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbPolyline") (90 . 5) (70 . 0) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 275.886 -229.662) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 I cannot figure out what I have down wrong. Can anyone help. I will attach routine so far. Thanks TESTSTUD3.LSP
-
- lisp error
- entity error
-
(and 2 more)
Tagged with:
-
Hello. I hope you guys can help with my LISP. I am new to this, so forgive me if I sound too basic. A problem occurred all of a sudden, and it was working before. Now, when I open a dwg, it stalls at this portion of my acad file. That is how I narrowed it down to this particular LISP. I can see my maps, but they are stalled. After about 1 minute, it says that there is a "Fatal Error - Out of Memory". Do you guys have any idea on what to do? If I take out the "N" portion on this line (command "purge" "block" "*" "N"), it seems to work, but I have to click through several options in my command line to do anything on my map. (defun T:PURGEBLOCK () (if (and (/= (getvar "dwgname") "unnamed")(/= (substr (getvar "dwgname") 1 7) "Drawing")) (progn (setq wts (getvar "writestat")) (if (/= wts 0) (progn (command "purge" "block" "*" "N") (setq chg (getvar "dbmod")) (if (/= chg 0) (progn (setvar "cmdecho" 0) (princ "\n Saving purged drawing \n") (setvar "expert" 3) (command "save" "") (setvar "expert" 0) ; (snd) );end progn );end if );end progn );end if );end progn );end if (setvar "cmdecho" 0) (princ) )
- 10 replies
-
- lisp error
- lisp
-
(and 2 more)
Tagged with:
-
[LISP] First time writing LISP routine... trying to rotate, move and scale
chiimayred posted a topic in AutoLISP, Visual LISP & DCL
Hi guys, Total newb here, did some reading in the tutorials area in how to write lisps and I'm having issues with it not working. I'm trying to start off really simple hence the rotate, move and scale. This is my first time trying to program so please bear with me. Here is the code: (defun C:firstprog () (command "ro" all 1,2 45) (command "m" all 0,0 50,50) (command "sc" 0,0 25.4) ) When I try to run this i get an error: nil Any help would be appreciated. -
I'm hoping someone can help out with this one. I have a LISP that opens a DCL and prompts for user input, then sets the USERI2 variable. If I comment out the "if" function, the DCL works, and the USERI2 is set correctly. As soon as I put the IF back in, I get a "Bad Function" error that I cant seem to locate. Can any one help? DCL Code: notiftype : dialog { label = "Notification Type"; :column { : boxed_radio_column { label = "Notification Label Selection"; : radio_button { label = "Conventional Notification \"V\""; key = "nconv"; } : radio_button { label = "Addressable Notification \"A\""; key = "naddr"; } } } ok_cancel; } LISP Code: (defun c:INDCPLINE (/ r3 nconv naddr ) (setq r3 (getvar "USERI2")) (if (= r3 0) ( (setq dcl_id (load_dialog "notiftype.dcl")) (if (not (new_dialog "notiftype" dcl_id))(exit)) (action_tile "nconv" "(setq nconv $value)(setq nconv (atoi nconv))(setq naddr 0)") (action_tile "naddr" "(setq naddr $value)(setq naddr (atoi naddr))(setq nconv 0)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (start_dialog) ; (unload_dialog dcl_id) ) ) (if (= nconv 1)(COMMAND "userI2" 1)) (if (= naddr 1)(COMMAND "userI2" 2)) ;(command "._pline") )
-
Lisp Error (Can't find file in search path)
Alexico posted a topic in AutoCAD Bugs, Error Messages & Quirks
Hello. I have recently formated my pc , and i re install my Autocad 2011 version x86 and i loaded my personal Cuix. I have noticed that several lisps (block especialy , and scale lisps) are not working. When i try to add them in my files i receive an error , and a returning message , saying that Autocad "can't find file in search path". On the other hand other program lisps , which are contained on the same folder , are working fine. I google the problem for a solution and i found that several users re ccomend to add an new support path pointing out the folder where all lisp are located. I did so , but still lisps are not fuctioning...... Im attaching a screen shot of the problem im facing. I would really appreciate if anyone can help me. my folder where all lisps are being contained is the folder Named "Cad" (second in row). Thank you for your time , and looking forward for your answers. -
hi everyone just joined in and was wondering if any one with a good knowledge of lisp can go through the routine below which by the way is to generate an I beam with inputs from user and is not working. It does accept the inputs but nothing is drawn in the model space when i run it. Ill be much appreciative thanks in advance. Note the part highlighted red mmmmm not really sure about. Any by thway the icon is not part of the routine Routine start from here (defun c:ukc () ;define the function ;******************************************************** ;Save System Variables (setq oldsnap (getvar "osmode")) ;save snap settings (setq oldblipmode (getvar "blipmode")) ;save blipmode setting ;******************************************************** ;Switch OFF System Variables (setvar "osmode" 0) ;Switch OFF snap (setvar "blipmode" 0) ;Switch OFF Blipmode ;******************************************************** ;Get User Inputs (initget (+ 1 2 3)) ;check user input (setq wl (getdist "\nLength of Web : ")) ;get the length of the Length of Web (initget (+ 1 2 3)) ;check user input (setq fl (getdist "\nLength of Flange : ")) ;get the Length of Flange (initget (+ 1 2 3)) ;check user input (setq wt (getdist "\nWeb Thickness : ")) ;get the thickness of the Web (initget (+ 1 2 3)) ;check user input (setq ft (getdist "\nFlange Thickness : ")) ;get the Flange Thickness (initget (+ 1 2 3)) ;check user input (setq rr (getdist "\nRoot radius : ")) ;get the Root radius (initget (+ 1 2 3)) ;check user input (setq nd (getdist "\nDepth of Section : ")) ;get the depth of the Section ;End of User Inputs ;********************************************************* ;Get Insertion Point (setvar "osmode" 32) ;switch ON snap (while ;start of while loop (setq ip (getpoint "\nInsertion Point : ")) ;get the insertion point (setvar "osmode" 0) ;switch OFF snap ;******************************************************** ;Start of Polar Calculations (setq p2 (polar ip (dtr 90.0)(/ nd 2))) (setq p3 (polar p2 (dtr 180.0)(/ fl 2))) (setq p4 (polar p3 (dtr 270.0) ft)) (setq p5 (polar p4 (dtr 0.0) (-(-(/fl 2)(/wt 2)) rr))) (setq p56 (polar p5 (dtr 270.0) rr)) (setq p6 (polar p56 (dtr 0.0) rr)) (setq p7 (polar p6 (dtr 270.0) wl)) (setq p78 (polar p7 (dtr 180.0) rr)) (setq p8 (polar p78 (dtr 270.0) rr)) (setq p9 (polar p8 (dtr 180) rr)) (setq p10 (polar p9 (dtr 270) ft)) (setq p11 (polar p10 (dtr 0.0) fl)) (setq p12 (polar p11 (dtr 90) ft)) (setq p13 (polar p12 (dtr 180.0) (-(-(/fl 2)(/wt 2)) rr))) (setq p1314 (polar p13 (dtr 90) rr)) (setq p14 (polar p1314 (dtr 180.0) rr)) (setq p15 (polar p14 (dtr 90.0) wl)) (setq p1516 (polar p15 (dtr 0.0) rr)) (setq p16 (polar p1516 (dtr 90.0) rr)) (setq p17 (polar p16 (dtr 0.0)(-(-(/fl 2)(/wt 2)) rr))) (setq p18 (polar p17 (dtr 90.0) ft)) ;End of Polar Calculations ;********************************************************** ;Start of Command Function (command "Line" p2 p3 p4 p5 "c" "Line" p6 p7 "" "Line" p8 p9 p10 p11 p12 p13 "" "Line" p14 p15 "" "Line" p16 p17 p18 p2 "" "arc" p56 p6 p5 "" "arc" p78 p8 p7 "" "arc" p1314 p14 p13 "" "arc" p1516 p16 p15 "" ) ;End Command ;End of Command Function ;********************************************************** (setvar "osmode" 32) ;Switch ON snap );end of while loop ;********************************************************** ;Reset System Variable (setvar "osmode" oldsnap) ;Reset snap (setvar "blipmode" oldblipmode) ;Reset blipmode ;********************************************************** (princ) ;finish cleanly ) ;end of defun ;********************************************************** ;This function converts Degrees to Radians. (defun dtr (x) ;define degrees to radians function (* pi (/ x 180.0)) ;divide the angle by 180 then ;multiply the result by the constant PI ) ;end of function ;********************************************************** (princ) ;load cleanly ;**********************************************************
-
_$ (PUTPAGESETUP "101" "PDF LEDGER") ; error: no function definition: VLAX-GET-ACAD-OBJECT I found the following code which reads named page setups ans supposedly is able to set it up, but when finally manage to get it to run, it seems to have an error somewhere. ; Jason Piercey . May 16th, 2003 ; assign a pagesetup to a layout ; [layout] - string, layout name ; [setup] - string, pagesetup to assign ; return: T or nil ; modified by chris castelein 10-31-05 ; to pass paper size as an argument. ; original prompt code left in and remarked out. (defun putPagesetup (layout setup / layouts plots) (defun item-p (collection item) (if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (setq item (vla-item collection item)))))) item ) ) (and (or *acad* (setq *acad* (vlax-get-acad-object))) (or *doc* (setq *doc* (vla-get-activedocument *acad*))) (setq layouts (vla-get-layouts *doc*)) (setq plots (vla-get-plotconfigurations *doc*)) (setq layout (item-p layouts layout)) (setq setup (item-p plots setup)) (not (vla-copyfrom layout setup)) ) ) (defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) ) ) (reverse nlist) ) ; Return: list of all pagesetups defined in the current drawing or nil (defun getPagesetups () (massoc 3 (dictsearch (namedobjdict) "Acad_PlotSettings")) ) ; Jason Piercey . May 19th, 2003 ; assign pagesetup to layout(s) ; LIMITED testing ; written for Shawn McDonald (defun psetup (page / lst res) (vl-load-com) (setq lst (mapcar 'strcase (getPagesetups))) (while (not page) ;(setq page (strcase (getstring T "\nspecify pagesetup to apply: "))) (if (or (= "" page) (not (member page lst))) (progn (princ "\npagesetup not found") (setq page nil)) ) ) (initget "All Current") ;(if(not(setq res (getkword "\n[All/Current]apply pagesestup to which layout(s) <all>: "))) ;(setq res "All") (setq res "Current") (if (= "All" res) (foreach x (vl-remove "Model" (layoutlist)) (putPagesetup x page)) (putPagesetup (getvar "ctab") page) ) (princ "\nFinished") (princ) )
-
I have ACAD2010 & am attempting to use a LISP routine that inserts a block for a photo callout symbol & the text for the photo number. The file contains a command "SAVSET" which I can't find information for it's purpose or it's syntax. When I enter the command, I get an error at the command line which is as follows in red: Command: photo ; error: no function definition: SAVSET The LISP woutine is as follows: ; ********************************* PHOTO ********************************** ; ; ; *************************************************************************** ; ; ; *************************************************************************** (defun C:Photo (/ cpt note) (SAVSET '("CMDECHO" "CLAYER" "OSMODE" "ATTDIA")') (setvar "OSMODE" 0) (setvar "ATTDIA" 0) ;;(LYRSET "I-BLKO-PHOT" "1" "CONTINUOUS") USER HAS TO PICK THIS AS CURRENT LAYER TO BEGIN 4/25/02 ;; ;; Specify photo number to start with ;; (if (null pno) (setq pno 1)) (DEFAULT "Starting photo number" pno "INT") (setq pno input cpt (getpoint (strcat "\nPick location for camera "(itoa pno)": "))) ;; ;; Loop until no camera point is picked ;; (while cpt (princ (strcat "\nPick target for camera "(itoa pno)": ")) (command "UNDO" "G") (command "INSERT" "C:\Users\Shadow\Documents\CAD\LISP routines\G-SFOTO1" cpt "" "" pause) ;; allow operator to select optional note ;; (menu "P0" "photo" "Y") (setq note (getstring t "\nNote (RETURN for none): ")) ;; (menu "P0" "POP0" "N") (command "INSERT" "C:\Users\Shadow\Documents\CAD\LISP routines\G-SFOTO2" cpt "" "" "" pno (if note note "")) (setq pno (1+ pno) cpt "U") ; set cpt to "U" to enter and repeat while loop. (command "UNDO" "E") (while (and (not (null cpt)) (= "U" cpt)) (initget "U u ") (setq cpt (getpoint (strcat "\nUndo/Pick location for camera "(itoa pno)" or RETURN to exit: "))) (if (or (= "U" cpt) (= "u" cpt)) (progn (command "U") (setq pno (1- pno)))) ) ) (RESET) (princ)) Could anyone tell me more about the command &/or how to correct my error? Any help would be greatly appreciated. Rob