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.
Related
So I asked a similar question here about a month ago (Lisp - Extracting info from a list of comma separated values) and managed to put something together that almost meets my needs, but I am hitting a roadblock with a few things. I'll start with the code:
(defun c:poleid ( / fn fp lst l)
;; String to list convertor. This will separate coordinates and values by comma and store them in a variable as a list
(defun LM:str->lst ( str del / len lst pos )
(setq len (1+ (strlen del)))
(while (setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos len))
)
)
(reverse (cons str lst))
)
;; Prompt the user to select a .TXT file.
(setq fn (getfiled "Select UTM GPS file" "" "txt" 4))
;; Open the file and create an empty list
(setq fp (open fn "r") lst '())
;; Iterate the file, writing each line to the list (as a string)
(while (setq l (read-line fp))
(setq lst (cons l lst))
)
;; Close the file.
(close fp)
;; Reverse the list
(setq lst (reverse lst))
;; At this point, the data is stored in a variable (lst) and the file is closed.
;; Save current OSNAP MODE and turn off
(setq os (getvar 'osmode))
(setvar "osmode" 0)
;;Set pcount to 0
(setq pcount 0)
;; Iterate the list and draw a point
;; entity at each coordinate
(foreach item lst ;; For each line in lst
(setq items (LM:str->lst item ",")) ;;set variable items as a list of item, separated by commas. Set the las
(setq ptx (nth 2 items) pty (nth 1 items) ptz (nth 3 items) idn (nth 4 items)) ;; Set the pole (pt) x, y and z values from the 2nd, 3rd and 4th values of each line. Set notes to idn (as a string). UTM values are provided to this program as y,x,z
(setq idr (LM:str->lst idn " ") idn (nth 0 idr) idr (nth 1 idr)) ;;Set idr (Pole ID) as a list of idn, then set idn as the first half of the note (HP#) and idr as the second half
(cond ((wcmatch idn "HP") ;; Only process lines that have HP in the 5th value
(
(printc idn)
(setq ptxyz (strcat ptx "," pty "," ptz)) ;;Make the pole x, y, and z value into a single string, separated by commas
(setq idx (atof ptx) idx (- idx 5.0) idx (rtos idx)) ;;set the idx as real number version of ptx, subtract 5 from it, then convert back to a string
(setq idxyz (strcat idx "," pty "," ptz)) ;;Make the ID x, y, and z value into a single string, separated by commas
;;Insert pole and ID block at xyz coords, with idn as the HP number and idr as the pole ID
(command "insert" "G:\\Shared drives\\Project Tools\\Customized Tools\\CAD\\prog\\CWood_Pole_D.dwg" ptxyz "508" "508" "0") ;; Pole symbol set to an x/y scale of 20
(command "insert" "G:\\Shared drives\\Project Tools\\Customized Tools\\CAD\\prog\\POLENA.dwg" idxyz "25.4" "25.4" "0" idn idr) ;; Pole ID block set to an x/y scale of 1, with the top half showing the HP# and the bottom half showing the pole ID
(setq pcount (+ pcount 1)) ;;Add 1 to counter
))
)
)
;; Restore OSNAP MODE and close with count of poles inserted
(setvar 'osmode os)
(setq pcount (write-to-string pcount))
(princ pcount)
(princ " pole(s) have been successively added")
(princ)
)
This is fed a .txt file that contains GPS points. The test example I have been feeding the script is:
1000,1,2,3,HP
1001,10.000,2.000,3.000,HP21 blah
1002,15.000,2.000,3.000,HP22 2gt3
1003,20.000,2.000,3.000,CU
#,Easting,Northing,Elevation,Notes
What I want the code to do is insert a block (CWood_Pole_D.dwg) in at the Easting/Northing/Elevation, and then insert a second block (POLENA.dwg) 5 units to the left of that point. The second block contains two attributes, which I would like to pull from the notes (with the two attributes separated by a space). All of this should only happen when the notes begin with "HP" (which may be followed bynumbers and a letter, ex. HP22A). The last little bit just counts up each time a pair of blocks is successfully added, but even that is spitting out a .
The problem I am having is dealing with the notes part, and conversely the loop activating when the notes are anything but JUST "HP". I'm also sure there is a bunch of redundancy or useless code, but boy oh boy is it difficult to find good information that breaks down all the individual actions (like, what is happening with the Lee Mac string to list convertor?)
I think the match does not work:
(wcmatch idn "HP")
You can try this instead, you may need a wildcard to match e.g. "HP22":
(wcmatch idn "HP*")
The rest is fine, I'd encourage to split your setq into distinct lines for readability.
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 have two texts associated to a line. Because the texts represent some data of the line they are always considered children of the line and visible next to it. Through some lisp routines, if the data of the line change, the text entities reflect the change by changing their text. For that I have stored the handle of the line to each text as xdata and vice versa, e.g. the handles of the texts into the line.
The problem arises when I copy the line with the texts where each one gets a new handle but the stored xdata are giving the old handles which leads to further problems. I thought the vlr-copied reactor could solve my problem but since I am not very proficient with reactors I cant seem to make it work.
Could someone point me to the right direction? I found this
http://www.theswamp.org/index.php?topic=42654.0
but I cannot understand when I make a selection set of lines but also including non relevant other entities, how to pass the correct selection set to the reactor and get the handles updated.
Any suggestion appreciated. Thank you.
Firstly, you need to decide on the behaviour that you want the objects to exhibit assuming that either object (text or line) is copied independently of the other. Since the two objects are linked, you may need to decide which object is the 'master' and which is the 'slave'.
For example, if the text object is copied into empty space, you might decide that the resulting copy should be deleted, since there is no line to which it could refer. Whereas, if the line is copied into empty space, you might decide to replicate the associated text object and position it relative to the new line.
This is the approach that I followed when developing my Associative Textbox application (which is essentially solving the same problem of associating two objects in a drawing - in my case, a text object and a bounding frame).
In my application, I use a separate Object Reactor to handle the modification events for the text object and textbox respectively:
(vlr-object-reactor txt "tbox-textreactor"
'(
(:vlr-modified . tbox:textcallback)
(:vlr-copied . tbox:textcopied)
)
)
(vlr-object-reactor box "tbox-tboxreactor"
'(
(:vlr-modified . tbox:tboxcallback)
(:vlr-copied . tbox:tboxcopied)
)
)
Similar to your setup, these are built & configured on program load using Extended Entity Data (xData) attached to both the text and textbox.
When the Copy event for the texbox is fired (evaluating the tbox:tboxcopied callback function), I decide that a textbox cannot live without the text it encloses, and so I delete the orphan textbox from the drawing.
However, the most important point that you have to remember when working with object reactors is that you cannot modify the owner of an object reactor within its own callback function.
As such, for all modification events in which I need to modify the owner of the event, I generate a temporary Command Reactor which will fire after the object has been modified, so as to ensure that the object is not locked for modification.
For example, for the textbox copy event, I use the following:
(defun tbox:tboxcopied ( owner reactor params )
(if (/= 0 (car params))
(progn
(setq tbox:owner (append tbox:owner (list (car params))))
(vlr-command-reactor "tbox-tboxcopiedcommreactor"
'(
(:vlr-commandended . tbox:tboxcopiedcommandended)
(:vlr-commandcancelled . tbox:tboxcopiedcommandcancelled)
(:vlr-commandfailed . tbox:tboxcopiedcommandcancelled)
)
)
)
)
(princ)
)
I then remove this temporary Command Reactor within any of its own callback functions so as to prevent the propagation of redundant reactors in the drawing:
(defun tbox:tboxcopiedcommandended ( reactor params / ent )
(vlr-remove reactor) ;; <----- Remove temporary Command Reactor
(if
(and
(setq ent (car tbox:owner))
(member (cdr (assoc 0 (entget ent))) '("CIRCLE" "LWPOLYLINE"))
)
(entdel ent) ;; <----- Delete orphan textbox
)
(setq tbox:owner (cdr tbox:owner))
(princ)
)
Whereas, when the text is copied, I recreate the surrounding textbox and build the new association (again, generating a temporary Command Reactor to facilitate modification of the text object itself):
(defun tbox:textcopied ( owner reactor params )
(if (/= 0 (car params))
(progn
(setq tbox:owner (append tbox:owner (list (car params))))
(vlr-command-reactor "tbox-textcopiedcommreactor"
'(
(:vlr-commandended . tbox:textcopiedcommandended)
(:vlr-commandcancelled . tbox:textcopiedcommandcancelled)
(:vlr-commandfailed . tbox:textcopiedcommandcancelled)
)
)
)
)
(princ)
)
...and recreate the appropriate textbox as part of the callback function for the temporary Command Reactor:
(defun tbox:textcopiedcommandended ( reactor params / box ent enx val )
(vlr-remove reactor) ;; <----- Remove temporary Command Reactor
(if
(and
(setq ent (car tbox:owner))
(setq enx (entget ent (list tbox:app)))
(member (cdr (assoc 0 enx)) '("TEXT" "MTEXT"))
(setq val (cdadr (assoc -3 enx)))
(setq box (tbox:createbox enx (cdr (assoc 1000 val)) (cdr (assoc 1040 val))))
)
(progn
(entmod
(append (vl-remove (assoc 40 enx) (entget ent))
(list
(list -3
(list tbox:app
'(1002 . "{")
(cons 1005 (cdr (assoc 5 (entget box))))
(assoc 1000 val)
(assoc 1040 val)
'(1002 . "}")
)
)
)
)
)
(if (= 'vlr-object-reactor (type tbox:textreactor))
(vlr-owner-add tbox:textreactor (vlax-ename->vla-object ent))
)
(if (= 'vlr-object-reactor (type tbox:tboxreactor))
(vlr-owner-add tbox:tboxreactor (vlax-ename->vla-object box))
)
)
)
(setq tbox:owner (cdr tbox:owner))
(princ)
)
And the methods I have described above is the approach that I would recommend for your scenario:
When the text is copied, delete the resulting orphaned text object; when the line is copied, create a corresponding text object and build the association between the copied line & new text object.
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:
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 )