Hi folks,
I got this lisp that inserts a block with curve info (start and end points, radius, length) after selecting an arc... and it works great (thanks to - if I remember - Lee Mac, Tahrwat, and a few other I'm sure).
It works great when selecting single arcs, but it does not work when selecting polyline segments. The routine doesn't crash, but it populates the block attributes with "####" as it's not pulling data from the polyline segment properly (or at all actually).
Here is the code. Any help is as always greatly appreciated.
Code:
(defun c:CurveTagTEST (/ ent obj CL SCL CID SP EP RAD AL)
(setvar 'ATTDIA 0)
(setq CL (getvar "CLAYER"))
;;;;; Collect units information and set scale
(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"))
)
(defun GetObjectID ( obj doc )
;; Lee Mac
(if
(eq "X64"
(strcase
(getenv "PROCESSOR_ARCHITECTURE")
)
)
(vlax-invoke-method
(vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
)
(itoa (vla-get-Objectid obj))
)
)
;;;;; Collect arc data
(if (setq ent (car (entsel "\nSelect arc: ")))
(progn
(setq obj (vlax-ename->vla-object ent)
AL(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(GetObjectID obj doc) ">%).Arclength \\f \"%lu4%pr2\">%"
)
RAD (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(GetObjectID obj doc) ">%).Radius \\f \"%lu4%pr2\">%"
)
SP (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(GetObjectID obj doc) ">%).Startpoint \\f \"%lu4%pt3\">%"
)
EP (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(GetObjectID obj doc) ">%).Endpoint \\f \"%lu4%pt3\">%"
)
)
)
)
(setq CID (getstring "\nEnter Curve ID: "))
;;;;; Bring in block "MNLA Curve Tag r00" from Callouts.dwg
(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 Curve Tag r00"))
)
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
)
(vlax-release-object dbx)
;;;;; Insert and populate block
(command "-layer" "Make" "L-ANNO-SYMB" "Color" "3" "L-ANNO-SYMB" "Ltype" "CONTINUOUS" "" "Plot" "P" "" "")
(setvar "CLAYER" "L-ANNO-SYMB")
(setq p (getpoint "\n Specify point :"))
(command "_.-insert"
"MNLA Curve Tag r00"
"Scale"
SCL
"_none"
p
""
CID
AL
RAD
SP
EP
)
(setvar "CLAYER" CL)
(princ)
)