Eh... well no luck.
I think it has to do with the code in red which is replacing the SETQ for "AL" in the original code:
Code:
;;;;; 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: "))
Code:
(defun c:CurveTagTEST (/ *error* LM:Bulge->Arc ent obj
SCL CID SP EP RAD dbx p
utl lst doc dxf prt sel unit
start end
)
(defun *error* (x)
(if lst
(mapcar 'setvar '(ATTDIA ATTREQ CLAYER) lst)
)
(princ)
)
(defun LM:Bulge->Arc (p1 p2 b / c r)
;; Bulge to Arc - Lee Mac
(setq r (/ (* (distance p1 p2) (1+ (* b b))) 4 b)
c (polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b)))) r)
)
(if (minusp b)
(list c (angle c p2) (angle c p1) (abs r))
(list c (angle c p1) (angle c p2) (abs r))
)
)
;;;;; Collect units information and set scale
(cond
((= (setq unit (getvar "INSUNITS")) 1) (setq SCL 1))
((= unit 2) (setq SCL 0.08333))
((= unit 4) (setq SCL 25.4))
((= unit 5) (setq SCL 2.54))
((= unit 6) (setq SCL 0.0254))
(t
(setq unit nil)
(alert
"Current DWG set to non-standard units. Check UNITS settings"
)
)
)
;;;;; Collect arc data
(princ
"\nSelect arcs and LWpolyline with one arc segment as an arc :"
)
(if (and unit
(setq sel (ssget "_+.:S:E"
'((-4 . "<OR")
(-4 . "<AND")
(0 . "LWPOLYLINE")
(90 . 2)
(-4 . "<NOT")
(42 . 0.0)
(-4 . "NOT>")
(-4 . "AND>")
(0 . "ARC")
(-4 . "OR>")
)
)
)
(/= (setq CID (getstring "\nEnter Curve ID: ")) "")
(setq dxf (entget (ssname sel 0)))
)
(progn
(setq obj (vlax-ename->vla-object (ssname sel 0)))
(if (= (vla-get-objectname obj) "AcDbArc")
(setq prt "ArcLength"
rad (rtos (vlax-get obj 'radius) 4 3)
)
(setq prt "Length"
rad (last (LM:Bulge->Arc
(cdr (assoc 10 dxf))
(cdr (assoc 10 (reverse dxf)))
(cdr (assoc 42 dxf))
)
)
)
)
(setq lst (mapcar 'getvar '(ATTDIA ATTREQ CLAYER))
start (vlax-get obj 'Startpoint)
end (vlax-get obj 'Endpoint)
SP (strcat (rtos (car start) 4 3) ", " (rtos (cadr start) 4 3))
EP (strcat (rtos (car end) 4 3) ", " (rtos (cadr end) 4 3))
doc (vla-get-ActiveDocument (vlax-get-acad-object))
)
)
)
;;;;; 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 doc)
)
(vlax-release-object dbx)
;;;;; Insert and populate block
(command "-layer" "Make" "L-ANNO-SYMB" "Color"
"3" "L-ANNO-SYMB" "Ltype" "CONTINUOUS"
"" "Plot" "P" "" ""
)
(if
(and (or (tblsearch "BLOCK" "MNLA Curve Tag r00")
(alert
"Block name < MNLA Curve Tag r00 > is not yet existed."
)
)
(setq p (getpoint "\n Specify point :"))
(mapcar 'setvar '(ATTDIA ATTREQ) '(0 0))
)
(command "_.-insert"
"MNLA Curve Tag r00"
"Scale"
SCL
"_none"
p
""
CID
(strcat "%<\\AcObjProp Object(%<\\_ObjId "
(if (vlax-method-applicable-p
(setq utl (vla-get-Utility doc))
'GetObjectIdString
)
(vla-GetObjectIdString utl obj :vlax-false)
(itoa (vla-get-ObjectId obj))
)
">%)."
prt
">%"
)
RAD
SP
EP
)
)
(mapcar 'setvar '(ATTDIA ATTREQ CLAYER) lst)
(princ)
)
Arc Data lisp works only with Arc entities, not curved polyline segments.
Reply With Quote
Originally Posted by Bruno.Valsecchi
