Hi, i need a lisp to label some curve calculator values of civil 3D Like angle, radius, tangent distanse & external distance. i wrote a code but it's not like what I need (screenshot attached) and has wrong value (T & E). My code:
----------------------------------
(defun c:tafsili (/ ss acadModel precision ctr obj len rad ang txt txtObj tanDist extDist)
(if (setq ss (ssget '((0 . "ARC"))))
(progn
(setq acadModel (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq precision 2)
(setq ctr 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss ctr)))
(setq rad (rtos (vla-get-radius obj) 2 precision))
(setq ang (rtos (cvunit (vla-get-totalAngle obj) "radians" "degrees") 2 precision))
(setq tanDist (rtos (vlax-curve-getDistAtPoint obj (vlax-curve-getEndPoint obj)) 2 precision)) ; Wrong
(setq extDist (rtos (vlax-curve-getDistAtPoint obj (vlax-curve-getStartPoint obj)) 2 precision)) ; Wrong
(setq txt (strcat " A=" ang "°" " R=" rad "m" " T=" tanDist "m" " E=" extDist "m"))
(setq txtObj (vla-addtext acadModel txt (vla-get-center obj) 1))
(vla-put-alignment txtObj acAlignmentMiddleCenter)
(vla-put-textAlignmentPoint txtObj (vla-get-center obj))
(setq ctr (1+ ctr))
)
)
)
(princ)
)
Solved! Go to Solution.
Solved by CADaSchtroumpf. Go to Solution.
Solved by CADaSchtroumpf. Go to Solution.
Hi,
My code used to achieve this, polyarcs and arcs can be selected.
is it possible to draw an arrow from this box to midpoint of the arc (like my attached screenshot) in this lsp?
Hi,
You can try this version with leader
(vl-load-com)
(defun c:ARTDB ( / js n AcDoc Space ename obj pr nb typ_obj oldim oldlay a_base a_dir h_t
pt_start pt_end pt_cen rad alpha pt_vtx pt_mid dist_start dist_end seg_len seg_bulge)
(defun make_mlead (pt obj / ptlst arr nw_obj)
(setq
ptlst (append pt (polar pt (angle pt_cen pt_mid) (/ rad 3)))
arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
)
(vlax-safearray-fill arr ptlst)
(setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
(vla-put-contenttype nw_obj acMTextContent)
(vla-put-textstring nw_obj
(strcat
"{\\fArial Narrow|b0|i0|c0|p34;"
"A = " (angtos (- pi (* 2 alpha)) 0 4) "%%d"
"\\PR = " (rtos rad 2 3)
"\\PT = " (rtos (distance pt_start pt_vtx) 2 3)
"\\PD = " (rtos seg_len 2 3)
"\\PB = " (rtos (- (distance pt_cen pt_vtx) (abs rad)) 2 3)
"}"
)
)
(mapcar
'(lambda (x)
(entmod (subst x (assoc (car x) (entget (entlast))) (entget (entlast))))
)
(list
'(91 . -1023417196)
'(292 . 1)
'(141 . 1.5)
)
)
(entupd (entlast))
(vla-put-layer nw_obj (getvar "CLAYER"))
(vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
(vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
(vla-update nw_obj)
)
(princ "\nSélectionner des Arcs/PolyArcs .")
(setq
js
(ssget
'((-4 . "<OR")
(-4 . "<AND")
(0 . "POLYLINE")
(-4 . "<NOT")
(-4 . "&") (70 . 126)
(-4 . "NOT>")
(-4 . "AND>")
(0 . "LWPOLYLINE,ARC")
(-4 . "OR>"))
)
n -1
)
(cond
(js
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
nb 0
)
(cond
((null (tblsearch "LAYER" "Info ARTDB des Arcs"))
(vlax-put (vla-add (vla-get-layers AcDoc) "Info ARTDB des Arcs") 'Color "5")
)
)
(setq
oldim (getvar "dimzin")
oldlay (getvar "clayer")
a_base (getvar "ANGBASE")
a_dir (getvar "ANGDIR")
h_t (getdist (getvar "viewctr") (strcat "\nTaille du texte <" (rtos (getvar "textsize")) ">: "))
)
(if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
(setvar "dimzin" 0) (setvar "clayer" "Info ARTDB des Arcs")
(setvar "ANGBASE" 0) (setvar "ANGDIR" 0)
(repeat (sslength js)
(setq
ename (ssname js (setq n (1+ n)))
obj (vlax-ename->vla-object ename)
pr -1
nb 0
)
(setq typ_obj (vla-get-ObjectName obj))
(if (eq typ_obj "AcDbArc")
(progn
(setq
pt_start (vlax-get obj 'StartPoint)
pt_end (vlax-get obj 'EndPoint)
pt_cen (vlax-get obj 'Center)
rad (vlax-get obj 'Radius)
alpha (* (vlax-get obj 'TotalAngle) 0.5)
seg_len (vlax-get obj 'ArcLength)
pt_vtx (polar pt_cen (+ (vlax-get obj 'StartAngle) alpha) (+ rad (* rad (1- (/ 1 (cos alpha))))))
pt_mid (polar pt_cen (+ (vlax-get obj 'StartAngle) alpha) rad)
nb (1+ nb)
)
(make_mlead pt_mid obj)
)
(repeat (fix (vlax-curve-getEndParam obj))
(setq
dist_start (vlax-curve-GetDistAtParam obj (setq pr (1+ pr)))
dist_end (vlax-curve-GetDistAtParam obj (1+ pr))
pt_start (vlax-curve-GetPointAtParam obj pr)
pt_mid (vlax-curve-GetPointAtParam obj (+ 0.5 pr))
pt_end (vlax-curve-GetPointAtParam obj (1+ pr))
seg_len (- dist_end dist_start)
seg_bulge (vla-GetBulge obj pr)
)
(if (not (zerop seg_bulge))
(progn
(setq
rad (/ seg_len (* 4.0 (atan seg_bulge)))
alpha (+ (angle pt_start pt_end) (- (* pi 0.5) (* 2.0 (atan seg_bulge))))
pt_cen (polar pt_start alpha rad)
pt_vtx (polar pt_start (- alpha (* pi 0.5)) (* rad (/ (sin (* 2.0 (atan seg_bulge))) (cos (* 2.0 (atan seg_bulge))))))
alpha (if (< (* 2.0 (atan seg_bulge)) 0) (- pi (* 2.0 (atan seg_bulge))) (* 2.0 (atan seg_bulge)))
nb (1+ nb)
)
(make_mlead pt_mid obj)
)
)
)
)
)
(setvar "dimzin" oldim) (setvar "clayer" oldlay)
(setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir)
)
)
(prin1)
)
Can't find what you're looking for? Ask the community or share your knowledge.