Hiya gang,

I've cobbled together this code (with lots of help from, probably, Lee mac, Tharwat...) that allows my staff to select and arc and insert a block pre-populated with data extracted from the selected arc.

Works great... but it only works when selecting arcs. Selecting a curved segment of a polyline crashes it.

So, I'd love some advice to do two things:


  1. Allow it to work with curved polyline segments
  2. Modify it to use fields so that when the arc or polyline is modified, the data updates


Thanks as always!!!

-JP


Code:
(defun c:CurveTag (/ 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"))
)






;;;;; Collect arc data


(if (setq ent (car (entsel "\nSelect arc: ")))
(progn
(setq obj (vlax-ename->vla-object ent)
AL (strcat (rtos (vlax-get obj 'arclength) 4 3))
RAD (strcat (rtos (vlax-get obj 'radius) 4 3))
SP (strcat (rtos (car (vlax-get obj 'Startpoint)) 4 3) ", " (rtos (cadr (vlax-get obj 'Startpoint)) 4 3))
EP (strcat (rtos (car (vlax-get obj 'Endpoint)) 4 3) ", " (rtos (cadr (vlax-get obj 'Endpoint)) 4 3))
)
)
)


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