In need of a loop in my LISP...
A while back Lee Mac and Tharwat helped my create a lisp that inserts blocks from the tool palette and that factors in the value of INSUNITS.
I have modified it to insert a "tick" block at either end of a selected line/polyline. uncharacteristically, it worked the first time. ;-)
However, it only does one entity at a time and I'd love to be able to either:
- Select a bunch of entities at once or...
- Select one entity after another without exiting the command each time
Any help is as always, appreciated. Code below:
Code:
(defun c:test ( / CL SCL DBX ENT Startpoint Endpoint)
***** Get current layer info and make new layer for inserted blocks *****
(setq CL (getvar "CLAYER"))
(command "_.-Layer" "m" "L-ANNO-SYMB" "c" "3" "L-ANNO-SYMB" "")
***** Determine INUNITS value and set scale for inserted blocks *****
(cond ((= (getvar "INSUNITS") 1) (setq SCL 1))
((= (getvar "INSUNITS") 2) (setq SCL 0.08333))
((= (getvar "INSUNITS") 4) (setq SCL 25.4))
((= (getvar "INSUNITS") 5) (setq SCL 2.54))
((= (getvar "INSUNITS") 6) (setq SCL 0.0254))
(t (alert "Current DWG set to non-standard units. Check UNITS settings"))
)
***** Select entity and gather startpoint and endpoint values *****
(if (setq Ent (entsel))
(progn
(setq VL-Obj (vlax-ename->vla-object (car Ent )))
(setq StartPoint (vlax-curve-getStartPoint VL-Obj ))
(setq EndPoint (vlax-curve-getEndPoint VL-Obj ))
)
(princ "..no object selected" )
)
***** Import block from seed drawing *****
(defun open_dbx (dwg / dbx)
(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
(setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
(setq dbx (vlax-create-object
(strcat "ObjectDBX.AxDbDocument."
(substr (getvar "ACADVER") 1 2)
)
)
)
)
(vla-open dbx dwg)
dbx
)
(setq Dbx (open_dbx "X:/AutoCAD 2018/Drawings/Callouts.dwg"))
(vla-CopyObjects
Dbx
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject '(0 . 0))
(list (vla-item (vla-get-blocks dbx) "MNLA Transition Tick r20"))
)
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
)
(vlax-release-object dbx)
***** insert blocks at startpoint and endpoint of selected entity *****
(command "-insert" "MNLA Transition Tick r20" "Scale" SCL Startpoint "0")
(command "-insert" "MNLA Transition Tick r20" "Scale" SCL Endpoint "0")
***** return current layer to initial value *****
(setvar "CLAYER" CL)
(princ)
)
Re: In need of a loop in my LISP...
OK I'm a bit closer. I looked at some other stuff I had lying around and reordered the code and added a "While" to it. This works fine in that each time I select and entity, it correctly places the blocks on either end of it.
However, I can't gracefully exit the command, I need to use the ESC key. ENTER just places another set of blocks at the last 2 points used.
Code below. Moved sections in Green, additions in red.
Code:
(defun c:test ( / CL SCL DBX ENT Startpoint Endpoint)
***** Get current layer info and make new layer for inserted blocks *****
(setq CL (getvar "CLAYER"))
(command "_.-Layer" "m" "L-ANNO-SYMB" "c" "3" "L-ANNO-SYMB" "")
***** Determine INUNITS value and set scale for inserted blocks *****
(cond ((= (getvar "INSUNITS") 1) (setq SCL 1))
((= (getvar "INSUNITS") 2) (setq SCL 0.08333))
((= (getvar "INSUNITS") 4) (setq SCL 25.4))
((= (getvar "INSUNITS") 5) (setq SCL 2.54))
((= (getvar "INSUNITS") 6) (setq SCL 0.0254))
(t (alert "Current DWG set to non-standard units. Check UNITS settings"))
)
***** Iport block form seed drawing *****
(defun open_dbx (dwg / dbx)
(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
(setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
(setq dbx (vlax-create-object
(strcat "ObjectDBX.AxDbDocument."
(substr (getvar "ACADVER") 1 2)
)
)
)
)
(vla-open dbx dwg)
dbx
)
(setq Dbx (open_dbx "X:/AutoCAD 2018/Drawings/Callouts.dwg"))
(vla-CopyObjects
Dbx
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject '(0 . 0))
(list (vla-item (vla-get-blocks dbx) "MNLA Transition Tick r20"))
)
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
)
(vlax-release-object dbx)
***** Select entity and gather startpoint and enpoint values *****
(while
(if (setq Ent (entsel))
(progn
(setq VL-Obj (vlax-ename->vla-object (car Ent )))
(setq StartPoint (vlax-curve-getStartPoint VL-Obj ))
(setq EndPoint (vlax-curve-getEndPoint VL-Obj ))
)
(princ "..no object selected" )
***** insert blocks at startpoint and enpoint of selected entity *****
(command "-insert" "MNLA Transition Tick r20" "Scale" SCL Startpoint "0")
(command "-insert" "MNLA Transition Tick r20" "Scale" SCL Endpoint "0")
)
***** return current layer to initial value *****
(setvar "CLAYER" CL)
(princ)
)
Re: In need of a loop in my LISP...
OK, sorry you;re all privy to my chaotic though process... ;-)
I have it working almost.
It now does what I want, and exits when ENTER is pressed. However it also exist if I pick "off" an object.
Code below. Changes in red.
Code:
(defun c:test2 ( / CL SCL DBX ENT ENT2 Startpoint Endpoint)
***** Get current layer info and make new layer for inserted blocks *****
(setq CL (getvar "CLAYER"))
(command "_.-Layer" "m" "L-ANNO-SYMB" "c" "3" "L-ANNO-SYMB" "")
***** Determine INUNITS value and set scale for inserted blocks *****
(cond ((= (getvar "INSUNITS") 1) (setq SCL 1))
((= (getvar "INSUNITS") 2) (setq SCL 0.08333))
((= (getvar "INSUNITS") 4) (setq SCL 25.4))
((= (getvar "INSUNITS") 5) (setq SCL 2.54))
((= (getvar "INSUNITS") 6) (setq SCL 0.0254))
(t (alert "Current DWG set to non-standard units. Check UNITS settings"))
)
***** Iport block form seed drawing *****
(defun open_dbx (dwg / dbx)
(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
(setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
(setq dbx (vlax-create-object
(strcat "ObjectDBX.AxDbDocument."
(substr (getvar "ACADVER") 1 2)
)
)
)
)
(vla-open dbx dwg)
dbx
)
(setq Dbx (open_dbx "X:/AutoCAD 2018/Drawings/Callouts.dwg"))
(vla-CopyObjects
Dbx
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject '(0 . 0))
(list (vla-item (vla-get-blocks dbx) "MNLA Transition Tick r20"))
)
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
)
(vlax-release-object dbx)
***** Select entity and gather startpoint and enpoint values *****
(while
(setq Ent (entsel))
(progn
(setq VL-Obj (vlax-ename->vla-object (car Ent )))
(setq StartPoint (vlax-curve-getStartPoint VL-Obj ))
(setq EndPoint (vlax-curve-getEndPoint VL-Obj ))
)
(command "-insert" "MNLA Transition Tick r20" "Scale" SCL Startpoint "0")
(command "-insert" "MNLA Transition Tick r20" "Scale" SCL Endpoint "0")
)
***** return current layer to initial value *****
(setvar "CLAYER" CL)
(princ)
)
