I'm trying to insert blocks with custom properties. How do I set those variables?
Within the Deciduous block there is a custom property called "visibility" with various different styles (Visibility 1, Visibility 2, Visibility 3, ...).
For instance, how would I insert the Deciduous block with Visibility 3.
(DEFUN C:TREE ( / DECIDUOUS CONIFER SHRUBMEDIUM SHRUBSMALL)
(INITGET 1 "DECIDUOUS CONIFER SHRUBMEDIUM SHRUBSMALL")
(OR
(SETQ RETKWORD (GETKWORD "\nSpecify tree type: [DECIDUOUS/CONIFER/SHRUBMEDIUM/SHRUBSMALL]:"))
(SETQ RETKWORD "DECIDUOUS")
)
(IF (= RETKWORD "DECIDUOUS")
(PROGN
(SETQ OLDLAYER (GETVAR "CLAYER"))
(SETQ FLAG (TBLSEARCH "LAYER" "L-PLNT-DECD"))
(IF FLAG
(SETVAR "CLAYER" "L-PLNT-DECD")
)
(INITGET 1 "Visibility1 Visibility2 Visibility3")
(OR
(SETQ CMDKWORD (GETKWORD "\nPick a command: [Visibility1/Visibility2/Visibility3]:"))
)
(IF (= CMDKWORD "Visibility3")
(PROGN
(COMMAND "INSERT"
"TT-L-TREE-DECIDUOUS"
)
)
)
(PRINC)
)
)
)
The answer to this question ultimately depends on whether or not you require the visual preview of the inserted block reference, as afforded by the AutoCAD INSERT command.
Since the standard AutoCAD INSERT command does not prompt for dynamic block parameter values during block insertion, you'll need to insert the block and then manipulate the visibility state using the ActiveX properties & methods of the inserted dynamic block reference, specifically, using the getdynamicblockproperties method.
If the visual preview of the inserted block is NOT required...
...then you can forego the INSERT command entirely, and use the insertblock method of the target container object (modelspace/paperspace/block definition), which will return a block reference vla-object.
Here is a basic example demonstrating how to use the insertblock method:
(defun c:test ( / dwg ins )
(if
(and
(setq dwg (getfiled "Select Block" "" "dwg" 16))
(setq ins (getpoint "\nSpecify insertion point: "))
)
(vla-insertblock
(vlax-get-property
(vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
(vlax-3D-point (trans ins 1 0))
dwg
1.0 1.0 1.0 0.0
)
)
(princ)
)
(vl-load-com) (princ)
This method will return a block reference vla-object, whose dynamic block properties you can then manipulate using the array of dynamic block properties returned by the getdynamicblockproperties method.
Since you are looking to modify the Visibility State in particular, you may wish to consider the following set of functions that I have developed as part of my dynamic block library to modify the visibility state of a supplied block reference object:
;; Set Dynamic Block Visibility State - Lee Mac
;; Sets the Visibility Parameter of a Dynamic Block (if present) to a specific value (if allowed)
;; blk - [vla] VLA Dynamic Block Reference object
;; val - [str] Visibility State Parameter value
;; Returns: [str] New value of Visibility Parameter, else nil
(defun LM:SetVisibilityState ( blk val / vis )
(if
(and
(setq vis (LM:getvisibilityparametername blk))
(member (strcase val) (mapcar 'strcase (LM:getdynpropallowedvalues blk vis)))
)
(LM:setdynpropvalue blk vis val)
)
)
;; Get Visibility Parameter Name - Lee Mac
;; Returns the name of the Visibility Parameter of a Dynamic Block (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; Returns: [str] Name of Visibility Parameter, else nil
(defun LM:getvisibilityparametername ( blk / vis )
(if
(and
(vlax-property-available-p blk 'effectivename)
(setq blk
(vla-item
(vla-get-blocks (vla-get-document blk))
(vla-get-effectivename blk)
)
)
(= :vlax-true (vla-get-isdynamicblock blk))
(= :vlax-true (vla-get-hasextensiondictionary blk))
(setq vis
(vl-some
'(lambda ( pair )
(if
(and
(= 360 (car pair))
(= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair)))))
)
(cdr pair)
)
)
(dictsearch
(vlax-vla-object->ename (vla-getextensiondictionary blk))
"ACAD_ENHANCEDBLOCK"
)
)
)
)
(cdr (assoc 301 (entget vis)))
)
)
;; Get Dynamic Block Property Allowed Values - Lee Mac
;; Returns the allowed values for a specific Dynamic Block property.
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; Returns: [lst] List of allowed values for property, else nil if no restrictions
(defun LM:getdynpropallowedvalues ( blk prp )
(setq prp (strcase prp))
(vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'allowedvalues)))
(vlax-invoke blk 'getdynamicblockproperties)
)
)
;; Set Dynamic Block Property Value - Lee Mac
;; Modifies the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil
(defun LM:setdynpropvalue ( blk prp val )
(setq prp (strcase prp))
(vl-some
'(lambda ( x )
(if (= prp (strcase (vla-get-propertyname x)))
(progn
(vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
(cond (val) (t))
)
)
)
(vlax-invoke blk 'getdynamicblockproperties)
)
)
You might call the above functions from the earlier example I provided in the following way (changing the name of the visibility state to suit your block of course):
(defun c:test ( / dwg ins )
(if
(and
(setq dwg (getfiled "Select Block" "" "dwg" 16))
(setq ins (getpoint "\nSpecify insertion point: "))
)
(LM:SetVisibilityState
(vla-insertblock
(vlax-get-property
(vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
(vlax-3D-point (trans ins 1 0))
dwg
1.0 1.0 1.0 0.0
)
"YourVisibilityState"
)
)
(princ)
)
(vl-load-com) (princ)
If the visual preview of the inserted block IS required...
...Then aside from rolling your own version of the standard INSERT command using a grread loop (which would also need to imitate all drawing aids, such as Object Snap, and Orthomode), you would need to make use of the INSERT command.
However, since the visibility state of the block can only be changed following the insertion of the block reference, the visual preview displayed to the user will be inaccurate.
To get the best of both worlds, I have previously proposed the following possible solution (along with an accompanying function posted here):
;; Example demonstrating a method to insert a Dynamic Block with a Visibility State already set.
;; Lee Mac - 2013-12-24
(defun c:test ( / *error* att blk def doc ent new obj par spc tmp vis )
(defun *error* ( msg )
(if (= 'int (type att))
(setvar 'attreq att)
)
(foreach obj (list new def)
(if (and (= 'vla-object (type obj)) (not (vlax-erased-p obj)))
(vl-catch-all-apply 'vla-delete (list obj))
)
)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(cond
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
(princ "\nCurrent layer locked.")
)
( (null (setq blk (getfiled "Select Dynamic Block with Visibility States" "" "dwg" 16)))
(princ "\n*Cancel*")
)
( (progn
(setq doc (vla-get-activedocument (vlax-get-acad-object))
spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
obj (vlax-invoke spc 'insertblock '(0.0 0.0 0.0) blk 1.0 1.0 1.0 0.0)
)
(vla-put-visible obj :vlax-false)
(= :vlax-false (vla-get-isdynamicblock obj))
)
(princ "\nSelected block is not dynamic.")
(vla-delete obj)
)
( (null (setq par (LM:getvisibilityparametername obj)))
(princ "\nSelected block does not have a visibility parameter.")
(vla-delete obj)
)
( (null (setq vis (car (LM:listbox "Choose a Visibility State" (acad_strlsort (LM:getdynpropallowedvalues obj par)) 0))))
(princ "\n*Cancel*")
(vla-delete obj)
)
( t
(LM:setdynpropvalue obj par vis)
(setq tmp 0)
(while (tblsearch "block" (setq blk (strcat "tmp" (itoa (setq tmp (1+ tmp)))))))
(vla-put-visible
(car
(vlax-invoke doc
'copyobjects
(list obj)
(setq def (vlax-invoke (vla-get-blocks doc) 'add '(0.0 0.0 0.0) blk))
)
)
:vlax-true
)
(vla-delete obj)
(setq ent (entlast)
att (getvar 'attreq)
)
(setvar 'attreq 0)
(if
(and
(vl-cmdf "_.-insert" blk "_S" 1.0 "_R" 0.0 "\\")
(not (eq ent (setq ent (entlast))))
(= "AcDbBlockReference" (vla-get-objectname (setq new (vlax-ename->vla-object ent))))
)
(progn
(vla-explode new)
(vla-delete new)
)
)
(vl-catch-all-apply 'vla-delete (list def))
)
)
(princ)
)
;; Get Visibility Parameter Name - Lee Mac
;; Returns the name of the Visibility Parameter of a Dynamic Block (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; Returns: [str] Name of Visibility Parameter, else nil
(defun LM:getvisibilityparametername ( blk / vis )
(if
(and
(vlax-property-available-p blk 'effectivename)
(setq blk
(vla-item
(vla-get-blocks (vla-get-document blk))
(vla-get-effectivename blk)
)
)
(= :vlax-true (vla-get-isdynamicblock blk))
(= :vlax-true (vla-get-hasextensiondictionary blk))
(setq vis
(vl-some
'(lambda ( pair )
(if
(and
(= 360 (car pair))
(= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair)))))
)
(cdr pair)
)
)
(dictsearch
(vlax-vla-object->ename (vla-getextensiondictionary blk))
"acad_enhancedblock"
)
)
)
)
(cdr (assoc 301 (entget vis)))
)
)
;; Get Dynamic Block Property Allowed Values - Lee Mac
;; Returns the allowed values for a specific Dynamic Block property.
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; Returns: [lst] List of allowed values for property, else nil if no restrictions
(defun LM:getdynpropallowedvalues ( blk prp )
(setq prp (strcase prp))
(vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'allowedvalues)))
(vlax-invoke blk 'getdynamicblockproperties)
)
)
;; Set Dynamic Block Property Value - Lee Mac
;; Modifies the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil
(defun LM:setdynpropvalue ( blk prp val )
(setq prp (strcase prp))
(vl-some
'(lambda ( x )
(if (= prp (strcase (vla-get-propertyname x)))
(progn
(vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
(cond (val) (t))
)
)
)
(vlax-invoke blk 'getdynamicblockproperties)
)
)
;; List Box - Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
(defun LM:listbox ( msg lst bit / dch des tmp rtn )
(cond
( (not
(and
(setq tmp (vl-filename-mktemp nil nil ".dcl"))
(setq des (open tmp "w"))
(write-line
(strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
(if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
)
des
)
(not (close des))
(< 0 (setq dch (load_dialog tmp)))
(new_dialog "listbox" dch)
)
)
(prompt "\nError Loading List Box Dialog.")
)
( t
(start_list "list")
(foreach itm lst (add_list itm))
(end_list)
(setq rtn (set_tile "list" "0"))
(action_tile "list" "(setq rtn $value)")
(setq rtn
(if (= 1 (start_dialog))
(if (= 2 (logand 2 bit))
(read (strcat "(" rtn ")"))
(mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
)
)
)
)
)
(if (< 0 dch)
(unload_dialog dch)
)
(if (and tmp (setq tmp (findfile tmp)))
(vl-file-delete tmp)
)
rtn
)
(vl-load-com) (princ)
My solution essentially involves temporarily inserting a block reference, configuring the visibility state appropriately, creating a temporary block definition containing the configured dynamic block, and then exploiting the visual preview offered by the standard INSERT command to insert the temporary block reference, which is then exploded & purged from the drawing.
Blocks with custom properties are called Dynamic blocks.
Details and samples You can find here
p.s.
Thank You #LeeMac
Related
I have to write the function that determines the number and values of block attributes in AutoLisp.
I have function which count the atributes:
(defun c:Test (/ s ss)
(if (and (princ "\n Select FIRST Attributed Block :")
(setq s (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
(princ "\n Select the SECOND Attributed Block :")
(setq ss (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
)
(mapcar
'length
(mapcar
'(lambda (a)
(mapcar
'(lambda (x) (vla-get-textstring x))
(vlax-invoke (vlax-ename->vla-object a) 'getattributes)
)
)
(list (ssname s 0) (ssname ss 0))
)
)
)
)**
A function that returns the values of attributes:
(defun c:Test (/ ss n e x)
(while (progn (princ "\n Select single attributed block :")
(setq ss (ssget "_+.:S" '((0 . "INSERT") (66 . 1))))
)
(setq n (entnext (ssname ss 0)))
(while (not (eq (cdr (assoc 0 (setq e (entget n)))) "SEQEND" ))
(if (eq (cdr (assoc 0 e)) "ATTRIB")
(print (cdr (assoc 1 e)))
)
(setq n (entnext n))
)
)
(princ)
)
Could you help me to combine this to functions into one?
Here is a lisp program that will loop over all blocks from a user selection set and:
1.) print block name
2.) print the association list of AttributeTag.AttributeValue
3.) print the list of AttributeTags
4.) print the list of AttributeValues
5.) print the number of AttributeValues
I also attached what the command line output should look like.
Lisp command line output
;;www.cadwiki.net
(defun c:test (/ SSINPUT)
(setq ssInput (ssget (list '(0 . "insert"))))
(PRINT-BLOCK-ATTRIBUTE-INFO ssInput)
(princ)
)
(defun PRINT-BLOCK-ATTRIBUTE-INFO (ssInput / ATTRIBUTETAGS ATTRIBUTETAGSTOVALUES ATTRIBUTEVALUES BLOCKENTITY BLOCKVLAOBJECT I NUMBEROFBLOCKATTRIBUTES
)
(setq i 0)
(if (= ssInput nil)
(progn
(princ "ssInput was nothing, exiting.")
(exit)
)
)
(princ (strcat "\nItems in selection set: " (itoa (sslength ssInput))))
(while (< i (sslength ssInput))
(setq blockEntity (ssname ssInput i))
(setq blockVlaObject (vlax-ename->vla-object blockEntity))
(setq attributeTagsToValues (GET-BLOCK-ATTRIBUTE-NAME-TO-VALUE-ASSOC blockEntity))
(princ (strcat "\nBlock name: " (vla-get-name blockVlaObject)))
(princ "\nBlock attributes tag to values association list: ")
(princ attributeTagsToValues)
(setq attributeTags (GET-NTHS-FROM-LISTS 0 attributeTagsToValues nil))
(princ "\nBlock attribute tags list: ")
(princ attributeTags)
(setq attributeValues (GET-LAST-ITEM-FROM-EACH-LIST attributeTagsToValues))
(princ "\nBlock attributes values list: ")
(princ attributeValues)
(princ "\nNumber of block attributes: ")
(setq numberOfBlockAttributes (itoa (length attributeValues)))
(princ numberOfBlockAttributes)
(setq i (+ i 1))
)
)
(defun GET-NTHS-FROM-LISTS (N LSTs removeDuplicates / CT LST2 LST IT)
(setq LST2 nil)
(foreach LST LSTs
(setq IT (nth N LST))
(if removeDuplicates
(if (not (member IT LST2))
(setq LST2 (append LST2 (list IT)))
)
(setq LST2 (append LST2 (list IT)))
)
)
LST2
)
(defun GET-LAST-ITEM-FROM-EACH-LIST (LSTs / CDRs FAIL LST)
(setq CDRs nil
FAIL nil
)
(if (not (= (type LSTs) 'LIST))
(setq FAIL "not a list")
)
(if (not FAIL)
(foreach LST LSTs
(setq FAIL (cond
((not (= (type LST) 'LIST)) "non-list member")
((not (cdr LST)) "no CDR")
(T nil)
)
)
(if (not FAIL)
(setq CDRs (append CDRs (list (cdr LST))))
)
)
)
CDRs
)
(defun GET-BLOCK-ATTRIBUTE-NAME-TO-VALUE-ASSOC (entity / COUNTER COUNTER2 COUNTERMAX COUNTERMAX2 DXFCODE0 DXFCODE2 DXFCODE66 DXFCODE8 DXFCODECODE-1 ENTITIESTORETURN ENTITYDXFCODES *ERROR* RETURNLIST
SUPPLIEDTRUENAME TRUENAME ATTRIBUTETAG ATTRIBUTEVALUE DXFCODE-1 ENTITYNAMEFORDRILLING SUBLIST TAGSANDVALUES THECALLINGFUNCTIONSNAME
)
(setq counter 0) ;initialize counter to 0 for while loop
(if ;if
(/= entity nil) ;entity is not nil
(progn ;progn wrap
(setq entityDxfCodes (entget entity)) ;set the varaible entityDxfCodes to the list of entities from the en varaible
;; you can use the method here to find any value from a dxfCodecode
(setq dxfCode-1 (cdr (assoc -1 entityDxfCodes))) ;set dxfCode-1 to the second element of the item that has -1 as it's first element, this is the entity name
(setq dxfCode0 (cdr (assoc 0 entityDxfCodes))) ;set dxfCode0 to the element of the item that has 0 as it's first element, this is the entity type
(setq dxfCode2 (cdr (assoc 2 entityDxfCodes))) ;set dxfCode8 to the second element of the item that has 8 as it's first element, this is the name, or block name
(setq dxfCode8 (cdr (assoc 8 entityDxfCodes))) ;set dxfCode8 to the second element of the item that has 8 as it's first element, this is the layer
(setq dxfCode66 (cdr (assoc 66 entityDxfCodes))) ;set dxfCode66 to the second element of the item that has 66 as it's first element, this is the attribute flag
(setq entityNameForDrilling entity)
(if ;if start
(= dxfCode66 1) ;entity attribute flag is 1
(progn ;progn wrap
(while (/= dxfCode0 "SEQEND") ;while loop to drill to each sub entity in a block
(setq attributeTag (cdr (assoc 2 entityDxfCodes))) ;set attributeTag to the second element of the second Dxf code (assoc 2) of the entityDxfCodes variable
(setq attributeValue (cdr (assoc 1 entityDxfCodes))) ;set attributeValue to the second element of the first Dxf code (assoc 1) of the entityDxfCodes variable
(if
(/= attributeValue nil)
(progn
(setq sublist (cons attributeTag attributeValue))
(setq tagsAndValues (cons sublist TagsAndValues))
)
)
(setq entityNameForDrilling (entnext entityNameForDrilling))
(setq entityDxfCodes (entget entityNameForDrilling))
(setq dxfCode0 (cdr (assoc 0 entityDxfCodes)))
)
) ;progn wrap end
) ;if end
) ;progn wrap end
) ;if end
(setq returnList tagsAndValues)
)
I would like to ask a question about automatizing polyline drawing. Here I have a FUNC and I want to add more specific commands. What I mean: I want the polyline to be assigned to a chosen layer automatically and i also want to set the line type to my custom line type. Thanks for the answers.
Here is my code:
You can get the newly created polyline with the entlast function and change its properties with _chprop command.
(defun c:nyomvodal (/ pt lst)
;; create a new layer
(command "_layer" "_new" "nyomvodal" "_color" 3 "nyomvodal" "")
;; get points form user
(while (setq pt (getpoint "\nPick point: "))
(setq lst (cons pt lst))
)
(if (< 2 (length lst))
(progn
;; create the polyline
(command "_pline")
(foreach p (reverse lst)
(command "_non" p)
)
(command "")
(command "_chprop" (entlast) "" "_layer" "nyomvodal" "_ltype" "axes" "")
)
)
(princ)
)
But, typically, we save current values of the OSMODE, CLAYER and CELTYPE system variables, set new values, draw the polyline, and restore the previous values.
(defun c:nyomvodal (/ osmode clayer celtype)
;; save the current osmode, clayer and celtype
(setq osmode (getvar "osmode"))
(setq clayer (getvar "clayer"))
(setq celtype (getvar "celtype"))
;; create a new layer and make it current
(command "_layer" "_make" "nyomvodal" "_color" 3 "nyomvodal" "")
;; set the current osmode and line type
(setvar "osmode" 0)
(setvar "celtype" "AXES")
;; use vla-catch-all-apply to avoid exiting code if user cancels
(vl-catch-all-apply
'(lambda (/ pt lst)
;; get points form user
(while (setq pt (getpoint "\nPick point: "))
(setq lst (cons pt lst))
)
(if (< 2 (length lst))
(progn
;; create the polyline
(command "_pline")
(foreach p (reverse lst)
(command p)
)
(command "")
)
)
)
)
;; restore the previous system variables values
(setvar "osmode" osmode)
(setvar "clayer" clayer)
(setvar "celtype" celtype)
(princ)
)
I'm trying to make drawing wiring diagrams extremely easy in AutoCAD with next to no button presses other than my pre-programmed ones.
One involves a LISP that is not playing nicely with setting system variables and then resetting them to what they were previously. The program seems to perform the intended function, but not with the intended results.
Once my PLINE command starts, the variables get reset. I need the PLINE to start, finish, and then the variables get reset.
I've tried setting OrthoMode and SnapMode within a command in the LISP, as well as through the (setvar (getvar ...)) commands.
(defun varget ()
(setq lis '("orthomode" "snapmode"))
(setq var (mapcar 'getvar lis))
(setq var1 '(1 1))
(setq no 0)
(repeat (length lis)
(setvar (nth no lis) (nth no var1))
(setq no (1+ no))
)
(princ)
)
(defun varset ()
(setq no 0)
(repeat (length lis)
(setvar (nth no lis) (nth no var))
(setq no (1+ no))
)
(princ)
)
(princ)
(defun C:wire ()
(progn
(varget)
(setq prevlayer (getvar "clayer"))
(setq P (getstring "Audio(A)/Video(V)/Comm(CO)/Coax(R)/Control(C)/(N)etwork/(P)ower:"))
(IF (= P "V")(command "-LAYER" "M" "VIDEO" "C" "150" "" "" "PLINE" PAUSE))
(IF (= P "A")(command "-LAYER" "M" "AUDIO" "C" "94" "" "" "PLINE" PAUSE))
(IF (= P "CO")(command "-LAYER" "M" "COMM" "C" "206" "" "" "PLINE" PAUSE))
(IF (= P "R")(command "-LAYER" "M" "COAX" "C" "44" "" "" "PLINE" PAUSE))
(IF (= P "C")(command "-LAYER" "M" "CONTROL" "C" "10" "" "" "PLINE" PAUSE))
(IF (= P "N")(command "-LAYER" "M" "NETWORK" "C" "210" "" "" "PLINE" PAUSE))
(IF (= P "P")(command "-LAYER" "M" "POWER" "C" "7" "" "" "PLINE" PAUSE))
(setvar "clayer" prevlayer)
(varset)
(princ)
);Progn
);defun
No error messages.
I expect the variables to be reset after performing the PLINE command.
The issue with your code is that you are only pausing for a single user input before attempting to reset the system variables and complete evaluation of the program.
Instead, you will need to use a loop to continuously pause for user input before continuing with program evaluation.
For example:
;; Define function, declare local symbols
(defun c:wire ( / col lay opt val var )
;; System variables to be modified within the program
(setq var '(clayer orthomode snapmode cmdecho)
;; Retrieve current sys var values
val (mapcar 'getvar var)
) ;; end setq
;; Predefine the getkword options
(initget "Audio Video COmm R Control Network Power")
;; Prompt the user for input, default to "Audio" on null input
(setq opt (cond ((getkword "\n[Audio/Video/COmm/Coax(R)/Control/Network/Power] <Audio>: ")) ("Audio")))
;; Define the layer & colour based on the option returned
(cond
( (= opt "Audio") (setq lay "AUDIO" col 94))
( (= opt "Video") (setq lay "VIDEO" col 150))
( (= opt "COmm") (setq lay "COMM" col 206))
( (= opt "R") (setq lay "COAX" col 44))
( (= opt "Control") (setq lay "CONTROL" col 10))
( (= opt "Network") (setq lay "NETWORK" col 210))
( (= opt "Power") (setq lay "POWER" col 7))
) ;; end cond
;; Suppress command-line output for the -LAYER command
(setvar 'cmdecho 0)
;; Create & set the layer & layer colour
(command "_.-layer" "_M" lay "_C" col "" "")
;; Set everything except the first sys var
(mapcar 'setvar (cdr var) '(1 1 1))
;; Initiate the PLINE command
(command "_.pline")
;; Continuously pause for user input
(while (= 1 (logand 1 (getvar 'cmdactive))) (command "\\"))
;; Reset system variables
(mapcar 'setvar var val)
;; Suppress the value returned by the last evaluated expression
(princ)
) ;; end defun
A few points to note:
Always declare your local variables to avoid clashing with identically named variables in the document namespace. See my tutorial here for more information on how & why you do this.
Use getkword in place of getstring to control & validate the user's input.
Use "\\" in place of the pause symbol, as the pause symbol is an unprotected global variable and can easily be inadvertently redefined outside of your program, causing your program to break. Since the pause symbol evaluates to "\\" you may as well use the literal backslash.
As an extension, you may also want to consider implementing a local error handler to handle when the user inevitably presses Esc during evaluation of the program (the system variables would otherwise not be reset under such circumstances). I describe how to do this in my tutorial here.
Here is a basic example demonstrating the inclusion of a local error handler:
;; Define function, declare local symbols
(defun c:wire ( / *error* col lay opt val var )
;; Define local error handler
(defun *error* ( msg )
;; Reset system variables
(mapcar 'setvar var val)
;; Suppress the output of standard cancellation messages
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
;; Print critical errors
(princ (strcat "\nError: " msg))
) ;; end if
(princ) ;; Suppress the value returned by the last evaluated expression
) ;; end defun
;; System variables to be modified within the program
(setq var '(clayer orthomode snapmode cmdecho)
;; Retrieve current sys var values
val (mapcar 'getvar var)
) ;; end setq
;; Predefine the getkword options
(initget "Audio Video COmm R Control Network Power")
;; Prompt the user for input, default to "Audio" on null input
(setq opt (cond ((getkword "\n[Audio/Video/COmm/Coax(R)/Control/Network/Power] <Audio>: ")) ("Audio")))
;; Define the layer & colour based on the option returned
(cond
( (= opt "Audio") (setq lay "AUDIO" col 94))
( (= opt "Video") (setq lay "VIDEO" col 150))
( (= opt "COmm") (setq lay "COMM" col 206))
( (= opt "R") (setq lay "COAX" col 44))
( (= opt "Control") (setq lay "CONTROL" col 10))
( (= opt "Network") (setq lay "NETWORK" col 210))
( (= opt "Power") (setq lay "POWER" col 7))
) ;; end cond
;; Suppress command-line output for the -LAYER command
(setvar 'cmdecho 0)
;; Create & set the layer & layer colour
(command "_.-layer" "_M" lay "_C" col "" "")
;; Set everything except the first sys var
(mapcar 'setvar (cdr var) '(1 1 1))
;; Initiate the PLINE command
(command "_.pline")
;; Continuously pause for user input
(while (= 1 (logand 1 (getvar 'cmdactive))) (command "\\"))
;; Reset system variables
(mapcar 'setvar var val)
;; Suppress the value returned by the last evaluated expression
(princ)
) ;; end defun
My intent is to create some lines having two texts each with short info (made as a group), and letting the reactor assigned to the line making sure that:
When copied, the handles of each entity will get updated with the info of the others and
In case I stretch the line using the end grip, the line reactor will update the length of the line as stored xdata and updating the text value that corresponds to the length.
So far and with the valuable help of this forum I was able to make it with the copy part of the story. When I try to incorporate the 'modified' option in the reactor, it does not work. Below is the code I use.
The first function assigns the reactor to the line during its creation through an other function, not shown here. The rest are callbacks and so on. Any suggestions appreciated.
In continuation to this question:
How to update xdata information of an entity when it is copied
(defun assign_LLreactor (LL_ename LL_Length LL_Size / LL_ename LL_hLength LL_hSize)
(if (= 'vlr-object-reactor (type lineReactor))
(vlr-owner-add lineReactor (vlax-ename->vla-object LL_ename))
(vlr-set-notification
(setq lineReactor
(vlr-object-reactor (list (vlax-ename->vla-object LL_ename)) "Line Reactor"
'(
(:vlr-modified . LL_callback_mod)
(:vlr-copied . LL_callback)
)
)
)
'active-document-only
)
)
(makeagroup (ssadd (handent LL_Length) (ssadd (handent LL_Size) (ssadd LL_ename (ssadd)))))
)
(defun LL_callback (notifierobj reactorobj paramls)
(if (/= 0 (car paramls))
(progn
(setq LL_owner (append LL_owner (list (car paramls))))
(vlr-command-reactor "LL_copied_re"
'(
(:vlr-commandended . LL_copyended)
(:vlr-commandcancelled . LL_copycancelled)
(:vlr-commandfailed . LL_copycancelled)
)
)
)
)
)
(defun LL_callback_mod (owner reactorobj paramls)
(setq LL_owner (append LL_owner (list owner)))
(vlr-command-reactor "LL_modified_re"
'(
(:vlr-commandended . LL_modifiedended)
(:vlr-commandcancelled . LL_modifiedcancelled)
(:vlr-commandfailed . LL_modifiedcancelled)
)
)
)
(defun LL_copyended ( reactor params / enametxt txt1 txt2 hSize hLength groupedentities txthandles grtxtdata)
(vlr-remove reactor)
(if
(and
(setq LL_ent (car LL_owner))
(setq LL_enx (entget LL_ent '("LL_U")))
(= (cdr (assoc 0 LL_enx)) "LINE")
(setq LL_3data (assoc -3 LL_enx))
)
(progn
(foreach n (setq groupedentities (_groupedenames LL_ent))
(if (= (cdr (assoc 0 (setq grtxtdata (entget n '("LL_U"))))) "TEXT")
(progn
(setq txthandles (append txthandles (list (cdr (assoc 5 grtxtdata)))))
(entmod (subst (list -3 (list "LL_U" (cons 1005 (cdr (assoc 5 LL_enx))))) (assoc -3 grtxtdata) grtxtdata))
)
)
)
(setq txthandles (vl-sort txthandles (function (lambda (a b) (< a b)))))
(entmod (subst (list -3 (list "LL_U" (cons 1005 (cadr txthandles)) (cons 1005 (car txthandles)))) (assoc -3 LL_enx) LL_enx))
)
)
(if (and LL_enx (= 'vlr-object-reactor (type lineReactor)))
(vlr-owner-add lineReactor (vlax-ename->vla-object LL_ent))
)
(setq LL_owner (cdr LL_owner))
(princ)
)
(defun LL_modifiedended ( reactor params / LL_ent LL_enx llpt10 llpt11 LL_3data LL_3data_n)
(if
(and
(setq LL_ent (car LL_owner))
(setq LL_enx (entget LL_ent '("Pdata")))
(= (cdr (assoc 0 LL_enx)) "LINE")
(setq LL_3data (assoc -3 LL_enx))
)
(progn
(if (= 'vlr-object-reactor (type lineReactor))
(vlr-remove lineReactor)
)
(setq llpt10 (cdr (assoc 10 LL_enx)))
(setq llpt11 (cdr (assoc 11 LL_enx)))
(setq LL_3data_n (list -3 (subst (cons 1000 (rtos (distance llpt10 llpt11) 2 3)) (nth 2 (cadr LL_3data)) (cadr LL_3data))))
(ht_ss (ssadd (cdr (assoc -1 (entmod (subst LL_3data_n (assoc -3 LL_enx) LL_enx)))) (ssadd)))
(if (= 'vlr-object-reactor (type lineReactor))
(vlr-add lineReactor)
)
)
)
(princ)
)
(defun LL_copycancelled ( reactor params )
(vlr-remove reactor)
(setq LL_owner nil)
(princ)
)
(defun LL_modifiedcancelled ( reactor params )
(vlr-remove reactor)
(setq LL_owner nil)
(princ)
)
I expect the object reactor works well for both 'modified' and 'copied' action for lines being either stretched or copied with updated xdata and texts.
So I managed to solve the issue by utilizing a separate list for the owners of the specific reactor type (e.g. 'copied' or 'modified'). So 'LL_owner' list became two, 'LL_copy_owner' and 'LL_mod_owner'. Now it works fine (until further notice :).
I am trying to call the following function:
(defun c:Add ()
(setq a (getint "Enter a number to add 2 to it"))
(setq a (+ a 2))
)
Inside this LOOPER function:
(defun LOOPER (func)
;repeats 'func' until user enters 'no'
(setq dummy "w")
(while dummy
(func) ;this is obviously the problem
(setq order (getstring "\nContinue? (Y or N):"))
(if (or (= order "N") (= order "n")) (setq dummy nil))
)
)
Like this:
(defun c:Adder ()
(LOOPER (c:Add))
)
How do I get around the fact that func is undefined in LOOPER function?
You can pass a function as an argument to another function as demonstrated by the following example:
(defun c:add ( / a )
(if (setq a (getint "\nEnter a number to add 2 to it: "))
(+ a 2)
)
)
(defun looper ( func )
(while
(progn
(initget "Y N")
(/= "N" (getkword "\nContinue? [Y/N] <Y>: "))
)
(func)
)
)
(defun c:adder ( )
(looper c:add)
)
Here, the symbol c:add is evaluated to yield the pointer to the function definition, which is then bound to the symbol func within the scope of the looper function. As such, within the scope of the looper function, the symbols func and c:add evaluate the same function.
Alternatively, you can pass the symbol c:add as a quoted symbol, in which case, the value of the symbol func is the symbol c:add which may then be evaluated to yield the function:
(defun c:add ( / a )
(if (setq a (getint "\nEnter a number to add 2 to it: "))
(+ a 2)
)
)
(defun looper ( func )
(while
(progn
(initget "Y N")
(/= "N" (getkword "\nContinue? [Y/N] <Y>: "))
)
((eval func))
)
)
(defun c:adder ( )
(looper 'c:add)
)
Passing a quoted symbol as a functional argument is more consistent with standard AutoLISP functions, such as mapcar, apply etc.
As far as I know, you can not send function name as the parameter, but here I give you a technic which can act like similar.
I don't have Autocad install on my machine so I am unable to test this code. but you can remove if there is any small mistake or grab the concept so you can implement your own.
(defun c:Add ()
(setq a (getint "Enter a number to add 2 to it"))
(setq a (+ a 2))
)
(defun c:sub ()
(setq a (getint "Enter a number to substract from 2:"))
(setq a (-2 a))
)
(defun c:mul ()
(setq a (getint "Enter a number to multiply with 2:"))
(setq a (* a 2))
)
;----This function use to call other function from function name
;----Function name string is case sensitive
;----As per need you can Add function name to this function
(Defun callFunction(name)
(setq output nil)
;here you can add nested if condition but for simplicity I use If alone
(if (= name "C:Add")(setq output (C:Add)))
(if (= name "C:sub")(setq output (C:sub)))
(if (= name "C:mul")(setq output (C:mub)))
output
)
;----------Function end here
(defun LOOPER (func)
;repeats 'func' until user enters 'no'
(setq dummy "w")
(while dummy
(callFunction func) ;Change here
(setq order (getstring "\nContinue? (Y or N):"))
(if (or (= order "N") (= order "n")) (setq dummy nil))
)
)
You like run this program like this:
(defun c:Adder ()
(LOOPER ("c:Add"))
)
(defun c:substaker ()
(LOOPER ("c:sub"))
)
(defun c:multiplyer ()
(LOOPER ("c:mul"))
)
Hope this helps: