What I would like to do is have an AutoLISP program call an executable file and get a response from that executable.
I understand that we are currently able to call applications with startapp e.g.
(startapp "notepad.exe" "acad.lsp")
but to my understanding, I don't believe that startapp can return values from the called application.
In context I would like to be able to call an application from lisp and when that application is closing, to send a status code back to the lisp that will allow it to continue execution.
in fake lisp code
(
(startapp "myapp.exe" "args")
(*DO UNTIL STATUS CODE == 1* or *"myapp.exe is stopped*
*CODE*
)
*CONTINUE EXECUTION
)
If something of this nature is possible in LISP, or if there is a better way to see if a process has ended in LISP, any direction would be appreciated.
Run the external application and wait until finish process You can do like this:
(command "_Shell" (strcat path app ) )
easy to run, but don't have easy access to returned value.
Or You can do it like this
(defun Sleep (n / lastCmdecho )
(setq lastCmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(eval (list 'VL-CMDF "_.delay" n ) )
(setvar "cmdecho" lastCmdecho )
)
(defun C:ExternalApplication ( / *error* )
(defun *error* ( msg / )
(if (not (null msg ) ) (progn (princ "\nC:ExternalApplication:*error*: " ) (princ msg ) (princ "\n") ) )
)
(setq path "C:\\Windows\\")
(setq app (strcat "Notepad.exe" ) )
(print (strcat "Run " (strcat path app ) ) )
(setq Shell (vlax-get-or-create-object "Wscript.Shell"))
(setq AppHandle(vlax-invoke-method Shell 'Exec (strcat path app ) ))
(while ( = (vlax-get-property AppHandle 'Status ) 0)
(Sleep 1000)
)`
(vlax-release-object Shell)
(print "Process finished" )
)
Now if Your application returns Status, You have it.
If Your application manipulates Acad environment You can set value by system variable (setvar) or environment variable (setenv).
If not, You can save value to system registry and read it for example by: (getcfg )
Related
I want to delete all attribute of block inside drawing using AutoLISP ObjectDBX method.
The below program works well: it deletes the attributes of all blocks inside the drawing, but when I edit this block in the Block Editor, I see all the attributes are still there.
I think I need to delete this attribute from definition of block.
;[dwgin]--input drawing file
;[dwgout]-- Output drawing fath with name
;function 'LM:GetDocumentObject' lee mac function to open drawing in ObjectDBX method
(defun DBXAttDelete ( dwgin dwgout / doc flg val )
(if (setq doc (LM:GetDocumentObject dwgin))
(progn
(vlax-for lyt (vla-get-layouts doc)
(vlax-for obj (vla-get-block lyt)
(if (and (= "AcDbBlockReference" (vla-get-objectname obj))
(= :vlax-true (vla-get-hasattributes obj))
)
(foreach att (vlax-invoke obj 'getattributes)
(if (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vla-delete (list att))))
(princ (strcat "\nERROR: " (vl-catch-all-error-message err)))
)
)
)
)
)
(vla-saveas doc dwgout)
(vlax-release-object doc)
flg
)
(prompt (strcat "\nThe drawing \"" dwgin "\" was not found or could not be accessed."))
)
)
Can you help to find where I need to improve/correct this program.
Consider that the Block Definition is essentially the "blueprint" for the block, and each Block Reference is an instance displaying the objects found within the block definition, at a specific position, scale, rotation & orientation in the drawing.
Attributes also have Attribute Definitions within the Block Definition, and corresponding Attribute References attached to each Block Reference. Such attribute references may then hold different text content for each block reference inserted in the drawing.
Aside, interestingly, attribute references may also be programmatically attached to a block reference independently of the block definition, however, this is not permitted when operating AutoCAD using the standard out-of-the-box front end.
As such, to remove all attributes from the drawing, you'll need to delete the attribute references associated with all block references, and the attribute definitions from the corresponding block definitions.
You may also want to unlock locked layers prior to performing the delete operation, and relock the previously locked layers following this operation.
Since layouts are merely a type of block, iterating over the blocks collection will be sufficient to process all layouts, blocks, and nested blocks (excluding xrefs):
(defun DBXAttDelete ( dwgin dwgout / doc lck )
(if (setq doc (LM:GetDocumentObject dwgin))
(progn
(vlax-for lay (vla-get-layers doc)
(if (= :vlax-true (vla-get-lock lay))
(progn
(setq lck (cons lay lck))
(vla-put-lock lay :vlax-false)
)
)
)
(vlax-for blk (vla-get-blocks doc)
(if (= :vlax-false (vla-get-isxref blk))
(vlax-for obj blk
(cond
( (= "AcDbBlockReference" (vla-get-objectname obj))
(if (= :vlax-true (vla-get-hasattributes obj))
(foreach att (vlax-invoke obj 'getattributes)
(vla-delete att)
)
)
)
( (= "AcDbAttributeDefinition" (vla-get-objectname obj))
(vla-delete obj)
)
)
)
)
)
(foreach lay lck
(vla-put-lock lay :vlax-true)
)
(vla-saveas doc dwgout)
(vlax-release-object doc)
t
)
(prompt (strcat "\nThe drawing \"" dwgin "\" was not found or could not be accessed."))
)
)
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
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:
When selecting a point is there a way to filter OSNAP to only snap onto a specific entity type and not an entity of another type. eg
Snap only to lines.
setq startpt (*SNAP FILTER CODE* "LINE" (getpoint "\nChoose Start Line : "))
Snap only to arcs.
setq startpt (*SNAP FILTER CODE* "ARC" (getpoint "\nChoose Start Arc: "))
Snap only to polyline.
setq startpt (*SNAP FILTER CODE* "POLYLINE" (getpoint "\nChoose Start Polyline: "))
I hope the fake lisp above helps in understanding what I'm trying to ask.
Thanks in advance.
The AutoLISP osnap function can be used to return a point snapped to geometry using a supplied Object Snap modifier, however, this function will not filter the candidate geometry.
Therefore, you could alternatively supply the point returned by getpoint as the point argument for a filtered ssget selection, or test the entity returned by the nentselp function.
Here is a possible solution using ssget:
(defun c:test1 ( / pnt )
(while
(and
(setq pnt (getpoint "\nSelect start point on arc: "))
(not (ssget pnt '((0 . "ARC"))))
)
(princ "\nThe point does not lie on an arc.")
)
(if pnt
(princ (strcat "\nThe user picked (" (apply 'strcat (mapcar 'rtos pnt)) ")."))
(princ "\nThe user did not supply a point.")
)
(princ)
)
Here is a possible solution using nentselp:
(defun c:test2 ( / ent pnt )
(while
(and (setq pnt (getpoint "\nSelect start point on arc: "))
(not
(and
(setq ent (car (nentselp pnt)))
(= "ARC" (cdr (assoc 0 (entget ent))))
)
)
)
(princ "\nThe point does not lie on an arc.")
)
(if pnt
(princ (strcat "\nThe user picked (" (apply 'strcat (mapcar 'rtos pnt)) ")."))
(princ "\nThe user did not supply a point.")
)
(princ)
)
It is possible to handle this issue, but it's very complicated.
What I can tell is that You may use function (grread) to get user input (mouse move or keyboard pressed). Then You have to analyse returned value, considering osnaps. here You may filter for example like this:
(cond
( ( = (vlax-get-property curve 'ObjectName ) "AcDbMLeader" ) ( progn
...
) )
( ( = (vlax-get-property curve 'ObjectName ) "AcDbPolyline" ) ( progn
...
) )
( YOUR NEXT CASES ( progn
...
) )
( t (progn
(princ "\n*Error:NotImplementedYetForThisEntity\n" ) )
) )
)
You have to draw Your own osnap markers (shapes draw for example by (grvecs) size based on system variables "VIEWSIZE" "SCREENSIZE". You need to handle polar tracking, ortho mode, keys pressed on the keyboard.
I tried to do it some time ago, didn't handle every case, and my code was hundreds of lines of code. Sorry, but I can not share all the code.
So probably You will spend weeks if You are the beginner in AutoLISP maybe even months on this way of solving the problem. So consider if You can spend so many time on this issue. Maybe problem You met may be handled in another way than filtering osnaps.
I have a small ELisp package that adds an External Tools menu to Emacs. It works on Microsoft Windows but I am having difficulty getting it to work on other operating systems. On Microsoft Windows I use the w32-shell-execute function. On other operating systems I use the start-process function.
My external-tools--exec function is as follows.
(defvar external-tools--exec-count 0)
(defun external-tools--exec (command &rest args)
(if args
(message "(external-tools--exec %s %s) called" command (mapconcat 'identity args " "))
(message "(external-tools--exec %s) called" command)
)
(setq external-tools--exec-count (+ external-tools--exec-count 1))
(cond
((fboundp 'w32-shell-execute)
(if args
(w32-shell-execute "open" command (mapconcat 'identity args " "))
(w32-shell-execute "open" command)
)
)
(t
(let ((external-tools--exec-process-name (format "external-tools--exec-%i" external-tools--exec-count)))
(if args
(apply 'start-process external-tools--exec-process-name nil command args)
(start-process external-tools--exec-process-name nil command)
)
)
)
)
)
This is an example of how I am using it.
(defun external-tools--explore-here ()
"Opens Windows Explorer in the current directory."
(interactive)
(let ((dir (external-tools--get-default-directory)))
(when (fboundp 'w32-shell-execute)
(w32-shell-execute "explore" (format "\"%s\"" dir))
)
(when (and (not (fboundp 'w32-shell-execute)) (executable-find "nautilus"))
(external-tools--exec (executable-find "nautilus") "-w" (format "\"%s\"" dir))
)
)
)
The external-tools--exec function works if args is nil, but it does not work if arguments are specified.
I would appreciate any advice on how to fix the external-tools--exec function.
Edit: I modified the function so that it does not use the convert-standard-filename function as Stefan recommended but the function still does not work. When I use the external-tools--explore-here function on GNU/Linux, I get the following error.
Unable to find the requested file. Please check the spelling and try again.
Unhandled error message: Error when getting information for file '/home/bkey/src/SullivanAndKey.com/SnK/Emacs/Home/.emacs.d/"/home/bkey/src/SullivanAndKey.com/SnK/Emacs/Home/.emacs.d/"': No such file or directory
I figured it out. The bug was not in the external-tools--exec function. It was in the calling function, external-tools--explore-here. I enclosed the directory in quotes, thinking it was necessary to deal with the possibility that there may be spaces in the directory path.
This turned out to be unnecessary.
The new function is as follows.
(defun external-tools--explore-here ()
"Opens Windows Explorer or Nautilus in the current directory."
(interactive)
(let ((dir (external-tools--get-default-directory)))
(when (fboundp 'w32-shell-execute)
(w32-shell-execute "explore" dir)
)
(when (and (not (fboundp 'w32-shell-execute)) (executable-find "nautilus"))
(external-tools--exec (executable-find "nautilus") "-w" dir)
)
)
)