Set and Reset of System Variables - AutoCAD LISP - lisp

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

Related

AutoCAD LISP automatizing polyline drawings

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)
)

How to insert a block with custom properties using AutoLISP?

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

Lisp - How to call a function within another function?

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:

convert vlax-ename->vla-object of multiple objects

what I am trying to do is trying to convert multiple entities into VLA-OBJECTS in prder to use the Vlisp functions available for them. What I am trying to do is:
(while (<= masa masas)
(set (read (strcat "off" (itoa masa) )) (cdr (assoc -1 (eval (read (strcat "offset" (itoa masa)))))))
(set (read (strcat "obj" (itoa masa) )) (vlax-ename->vla-object (read (strcat "off" (itoa masa) ))))
(setq masa (+ masa 1))
)
where masa is a counter that allows to go out of the while loop and masas is the variable limit. in wy code the first and the third line inside the while loop is working perfectly but the second one where I am trying to convert each ename into VLA object gives me the error bad argument type: lentityp OFF1 because in this case off starts in 1, I think the problem is not the uppercase result of read because lisp is not case-sensitive but rather than that a type problem that I can not solve. I also tried with eval or using directly assoc -1 but I have not been lucky.
The error message means OFF1 is not an ENAME (it's a symbol).
You need to evaluate the symbol value with (eval ...).
(while (<= masa masas)
(set (read (strcat "off" (itoa masa)))
(cdr (assoc -1 (eval (read (strcat "offset" (itoa masa))))))
)
(set (read (strcat "obj" (itoa masa)))
(vlax-ename->vla-object (eval (read (strcat "off" (itoa masa)))))
)
(setq masa (1+ masa))
)
IMO, you should rather use lists, instead of assigning all these incremented variables.
To use these variables, you'll need to loop through them with while or repeat as you could do with list and foreach.
Assuming offsetList is the list of the dxf lists (all your offset(n) values), you can simply build a list of enameS and a list of vla-objectS.
(setq offList (mapcar '(lambda (x) (cdr (assoc -1 x))) offsetList))
(setq objList (mapcar 'vlax-ename->vla-object offList))

Emacs cond, possible to have things happen between clauses?

I programmed some months ago some code with a lot of if statements. If region-active-p, if beginning-of-line, those kind of things.
Having learned about the cond lisp, I was wondering if I could improve my code a lot.
The problem is that this cond is only doing things when "true" as far as I see it, while I actually need the move back-to-indentation in between these checks.
In order to properly skip the last clause, I even have to set variable values.
(defun uncomment-mode-specific ()
"Uncomment region OR uncomment beginning of line comment OR uncomment end"
(interactive)
(let ((scvar 0) (scskipvar 0))
(save-excursion
(if (region-active-p)
(progn (uncomment-region (region-beginning) (region-end))
(setq scskipvar 1))
(back-to-indentation)) ; this is that "else" part that doesn't fit in cond
(while (string= (byte-to-string (following-char)) comment-start)
(delete-char 1)
(setq scskipvar 1))
(indent-for-tab-command)
(when (= scskipvar 0)
(search-forward comment-start nil t)
(backward-char 1)
(kill-line))
)))
)
So basically my question is, I would kind of like to have some consequences of not giving "true" to a clause, before the check of another clause. Is this possible? If not, what would be the best thing to do?
EDIT: Since we are using this as the example case for a solution, I wrote it down so it is easier to understand.
If region is active, remove comments from region. If not, move point to intendation.
For as long as the following character is a comment character, delete it. Afterwards, indent this line.
If it didn't do any of the above, search forward for a comment character, and kill that line.
(defun delete-on-this-line (regex)
(replace-regexp regex "" nil (line-beginning-position) (line-end-position)))
(defun delete-leading-comment-chars ()
(delete-on-this-line (eval `(rx bol (* space) (group (+ ,comment-start))))))
(defun delete-trailing-comment-chars ()
(delete-on-this-line (eval `(rx (group (+ ,comment-end)) (* space) eol))))
(defun delete-trailing-comment ()
(delete-on-this-line (eval `(rx (group (+ ,comment-start) (* anything) eol)))))
(defun uncomment-dwim ()
(interactive)
(save-excursion
(if (region-active-p)
(uncomment-region (region-beginning) (region-end))
(or (delete-leading-comment-chars)
(delete-trailing-comment-chars)
(delete-trailing-comment)))))
Edit: A little explanation:
It's a lot easier to do regex replacements than manage loops to do deletion, so that gets rid of the state. And the steps are all mutually exclusive, so you can just use or for each option.
The rx macro is a little DSL that compiles down to valid regexes, and it's also amenable to lispy syntax transforms, so I can dynamically build a regex using the comment chars for the current mode.
(defmacro fcond (&rest body)
(labels ((%substitute-last-or-fail
(new old seq)
(loop for elt on seq
nconc
(if (eql (car elt) old)
(when (cdr elt)
(error "`%S' must be the last experssion in the clause"
(car elt)))
(list new)
(list (car elt))))))
(loop with matched = (gensym)
with catcher = (gensym)
for (head . rest) in body
collect
`(when (or ,head ,matched)
(setq ,matched t)
,#(%substitute-last-or-fail `(throw ',catcher nil) 'return rest))
into clauses
finally
(return `(let (,matched) (catch ',catcher ,#clauses))))))
(macroexpand '(fcond
((= 1 2) (message "1 = 2"))
((= 1 1) (message "1 = 1"))
((= 1 3) (message "1 = 3") return)
((= 1 4) (message "1 = 4"))))
(let (G36434)
(catch (quote G36435)
(when (or (= 1 2) G36434)
(setq G36434 t)
(message "1 = 2"))
(when (or (= 1 1) G36434)
(setq G36434 t)
(message "1 = 1"))
(when (or (= 1 3) G36434)
(setq G36434 t)
(message "1 = 3")
(throw (quote G36435) nil))
(when (or (= 1 4) G36434)
(setq G36434 t)
(message "1 = 4"))))
Here's something quick to do, what I think you may be after, i.e. something that would mimic the behaviour switch in C.
The idea is that all clauses are tested sequentially for equality, and if one matches, then all following clauses are executed, until the return keyword (it would be break in C, but Lisp uses return for the similar purpose in the loop, so I thought that return would be better). The code above thus will print:
1 = 1
1 = 3
Technically, this is not how switch works in C, but it will produce the same effect.
One thing I did here for simplicity, which you want to avoid / solve differently - the use of return keyword, you probably want to impose stricter rules on how it should be searched for.
cond
Cond evaluates a series of conditions in a list, each item in a list can be a condition, and then executable instructions.
The example in the Emacs Lisp manual is adequate to demonstrate how it works, I've annotated it here to help you understand how it works.
(cond ((numberp x) x) ;; is x a number? return x
((stringp x) x) ;; is x a string? return x
((bufferp x) ;; is x a buffer?
(setq temporary-hack x) ;; set temporary-hack to buffer x
(buffer-name x)) ;; return the buffer-name for buffer x
((symbolp x) (symbol-value x))) ;; is x a symbol? return the value of x
Each part of the condition can be evaluated any way you like, the fact x above is in each condition is coincidental.
For example:
(cond ((eq 1 2) "Omg equality borked!") ;; Will never be true
(t "default")) ;; always true
So comparisons with switch are a bit limited, it's essentially a list of if statements, that executes/returns the first true condition's body list.
Hopefully this helps you understand cond a bit better.
(cond (condition body ... ) ;; execute body of 1st passing
(condition body ... ) ;; condition and return result
(condition body ... ) ;; of the final evaluation.
;; etc
)
OR
You can do things similar to switch with OR, depending on how you structure the code.
This isn't functional style, because it relies on side-effects to do what you want, then returns a boolean value for flow control, here's an example in pseudo lisp.
(or)
(or
(lambda() (do something)
(evaluate t or nil) ; nil to continue; t to quit.
)
(lambda() (do something)
(evaluate t or nil) ; nil to continue; t to quit.
)
(lambda() (do something)
(evaluate t or nil) ; nil to continue; t to quit.
)
(lambda() (do something)
(evaluate t or nil) ; nil to continue; t to quit.
)
)
Here's working example of a switch like structure using or
(or
(when (= 1 1)
(progn
(insert "hello\n")
nil))
(when (= 1 2) ;; condition fails.
(progn
(insert "hello\n")
nil)) ;; returns false (nil)
(when (= 1 1)
(progn
(insert "hello\n")
t)) ;; returns true, so we bail.
(when (= 1 1)
(progn
(insert "hello\n")
nil))
)
Inserts :
hello
hello
(and)
The and operator (not just in Lisp) is also very useful, instead of evaluating everything until true, it evaluates conditions that are true, until a false is evaluated.
Both or & and can be used to build useful logic trees.
This is how I did it now according to Chris' idea that breaking it down into seperate functions would make it easier.
EDIT: Now also applied the or knowledge gained in this thread gained from Slomojo (no more variables!)
(defun sc-uncomment ()
(interactive)
(or
(if (region-active-p)
(uncomment-region (region-beginning) (region-end))
(back-to-indentation)
nil)
(if (string= (byte-to-string (following-char)) comment-start)
(sc-check-start)
(sc-end))))
(defun sc-check-start ()
(interactive)
(while (string= (byte-to-string (following-char)) comment-start)
(delete-char 1))
)
(defun sc-end ()
(interactive)
(search-forward comment-start nil t)
(backward-char 1)
(kill-line))
)