View Full Version : delta radius length tangent lisp
mgonzales361438
2014-06-10, 04:33 PM
Hello all,
I have this lisp routine that i often use but i cannot seam to get it to show 2 decimal places.
I could use some help with this. thanks in advance.
here is the routine.
;DRLT - annotate Delta, Radius, Arc length, as Label
(defun c:DRLT (/ bc radp ec delta rad len brg sdelta srad slen tan stan)
(getarc)
(setq brg (angtos delta 1 4))
(dtod brg)
(setq sdelta (strcat "" brg)
srad (strcat "" (rtos rad 2 2))
slen (strcat "" (rtos len 2 2))
)
(setq tan (/ (sin (* delta 0.5)) (cos (* delta 0.5))))
(setq stan (strcat "" (rtos (* rad tan) 2 2))
scord (strcat "C=" (rtos (* 2 rad (sin (* delta 0.5))) 2 2))
)
(command "TEXT" pause pause sdelta)
(command "TEXT" "" srad)
(command "TEXT" "" slen)
(command "TEXT" "" stan)
(princ)
)
I couldn't make this routine work, and I couldn't figure out why.
Please use code tags.. it will help avoid smileys
;DRLT - annotate Delta, Radius, Arc length, as Label
(defun c:DRLT (/ bc radp ec delta rad len brg sdelta srad slen tan stan)
(getarc)
(setq brg (angtos delta 1 4))
(dtod brg)
(setq sdelta (strcat "" brg) srad (strcat "" (rtos rad 2 2)) slen (strcat "" (rtos len 2 2)))
(setq tan (/ (sin (* delta 0.5)) (cos (* delta 0.5))))
(setq stan (strcat "" (rtos (* rad tan) 2 2))scord (strcat "C=" (rtos (* 2 rad (sin (* delta 0.5))) 2 2)))
(command "TEXT" pause pause sdelta)
(command "TEXT" "" srad)
(command "TEXT" "" slen)
(command "TEXT" "" stan)
(princ)
)
Anywho...
I would suspect the decimal thing will be controlled in your drawing units, so that could be set in your code too.
Tom Beauford
2014-06-10, 06:19 PM
I attached an old routine that labels lines & arcs inserting a block with attributes with the text height matching the textsize variable. Put the lisp & drawings in the support path.
Bruno.Valsecchi
2014-06-11, 07:52 AM
Hi,
My version ARTDB (in french: Angle at vertex, Radius, Tangent, Development Cord, B against arrow?) for annotate arc info of polyline
If can help you?
(vl-load-com)
(defun c:ARTDB ( / js n AcDoc Space ename obj pr nb typ_obj oldim oldlay a_base a_dir
pt_start pt_end pt_cen rad alpha pt_vtx dist_start dist_end seg_len seg_bulge)
(defun grdraw-id_arc ( / )
(grdraw (trans pt_start 0 1) (trans pt_vtx 0 1) 1)
(grdraw (trans pt_vtx 0 1) (trans pt_end 0 1) 1)
(grdraw (trans pt_start 0 1) (trans pt_cen 0 1) 3)
(grdraw (trans pt_cen 0 1) (trans pt_end 0 1) 3)
)
(defun add_mt_arc ( / ins_txt h_t)
(initget 9)
(setq ins_txt (getpoint (trans pt_cen 0 1) "\nPoint d'insertion des informations de l'arc?: "))
(initget 6)
(setq h_t (getdist ins_txt (strcat "\nTaille du texte <" (rtos (getvar "textsize")) ">: ")))
(if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
(vla-addMtext Space
(vlax-3d-point (trans ins_txt 1 0))
0.0
(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)
"}"
)
)
(entmod
(append
(vl-remove-if
(function
(lambda (x)
(or (member (car x) '(90 63 421 45))
(< 419 (car x) 440)
)
)
)
(entget (entlast))
)
(list
'(90 . 1)
'(63 . 41)
'(421 . 16770196)
'(45 . 1.5)
)
)
)
(entupd (entlast))
)
(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")
)
(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))))))
nb (1+ nb)
)
(grdraw-id_arc)
(add_mt_arc)
)
(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_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)
)
(grdraw-id_arc)
(add_mt_arc)
)
)
)
)
)
(setvar "dimzin" oldim) (setvar "clayer" oldlay)
(setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir)
)
)
(prin1)
)
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.