Good day!
I am a working as a landscape detailer, and in our drawings we encounter a lot of arcs and curves which requires dimension angle and a dimension radius below at the same time in our setting out plan, i do not know lisp programming. Lisp masters please help me come up with a lisp with this routine. see my attached image for the dimension that i need and i hope it will work both in model space and layout..
Thank you very much,
Ron
Firstly setup Dimension Style - especially angular properties as type : decimal degrees with precision, degree/minutes/seconds with precision and instead of using DAN command, use DANR...
(defun c:danr ( / _plsegrad el e d dn db dt r txt txtn )
(vl-load-com)
(defun _plsegrad ( obj p / n p1 p2 bulge rad )
(setq n (fix (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj p))))
(setq p1 (vlax-curve-getpointatparam obj (float n)))
(setq p2 (vlax-curve-getpointatparam obj (float (1+ n))))
(setq bulge (vla-getbulge obj (float n)))
(if (/= bulge 0.0)
(setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
)
(abs rad)
)
(setq el (entlast))
(setq e (entsel "\nPick arced entity to dimension angular with radius value"))
(command "_.DIMANGULAR" (cadr e))
(while (> (getvar 'cmdactive) 0) (command "\\"))
(setq d (entlast))
(if (not (equal d el))
(progn
(if (or (eq (cdr (assoc 0 (entget (car e)))) "ARC") (eq (cdr (assoc 0 (entget (car e)))) "CIRCLE"))
(setq r (cdr (assoc 40 (entget (car e)))))
(if (eq (cdr (assoc 0 (entget (car e)))) "POLYLINE")
(progn
(command "_.CONVERTPOLY" "_L" (car e) "")
(setq r (_plsegrad (vlax-ename->vla-object (car e)) (trans (cadr e) 1 0)))
(command "_.CONVERTPOLY" "_H" (car e) "")
)
(setq r (_plsegrad (vlax-ename->vla-object (car e)) (trans (cadr e) 1 0)))
)
)
(setq dn (cdr (assoc 2 (entget d))))
(setq db (tblobjname "BLOCK" dn))
(setq dt db)
(while (/= (cdr (assoc 0 (entget (setq dt (entnext dt))))) "MTEXT"))
(setq txt (cdr (assoc 1 (entget dt))))
(setq ang (substr txt (+ 2 (vl-string-search ";" txt))))
(setq txtn (strcat "\\A1;\\S" ang "^R" (rtos r 2 2) ";"))
(entmod (subst (cons 1 txtn) (assoc 1 (entget dt)) (entget dt)))
)
)
(command "_.REGEN")
(princ)
)HTH, M.R.
Updated version, should successful work in all UCS / Views in 3D space...
(defun c:danr ( / *error* _plsegrad osm el e p d dn db dt r txt txtn )
(vl-load-com)
(defun *error* ( msg )
(if p (command "_.UCS" "_P"))
(if osm (setvar 'osmode osm))
(command "_.REGEN")
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(if msg (prompt msg))
(princ)
)
(defun _plsegrad ( obj p / n p1 p2 bulge rad )
(setq n (fix (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj p))))
(setq p1 (vlax-curve-getpointatparam obj (float n)))
(setq p2 (vlax-curve-getpointatparam obj (float (1+ n))))
(setq bulge (vla-getbulge obj (float n)))
(if (/= bulge 0.0)
(setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
)
(abs rad)
)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq el (entlast))
(setq osm (getvar 'osmode))
(setq e (entsel "\nPick arced entity to dimension angular with radius value"))
(command "_.UCS" "_E" (car e))
(setq p t)
(setvar 'osmode 512)
(setq p (getpoint "\nPick point on arced entity to dimension angular with radius value"))
(setvar 'osmode 0)
(command "_.DIMANGULAR" p)
(while (> (getvar 'cmdactive) 0) (command "\\"))
(setq d (entlast))
(if (not (equal d el))
(progn
(if (or (eq (cdr (assoc 0 (entget (car e)))) "ARC") (eq (cdr (assoc 0 (entget (car e)))) "CIRCLE"))
(setq r (cdr (assoc 40 (entget (car e)))))
(if (eq (cdr (assoc 0 (entget (car e)))) "POLYLINE")
(progn
(command "_.CONVERTPOLY" "_L" (car e) "")
(setq r (_plsegrad (vlax-ename->vla-object (car e)) (trans p 1 0)))
(command "_.CONVERTPOLY" "_H" (car e) "")
)
(setq r (_plsegrad (vlax-ename->vla-object (car e)) (trans p 1 0)))
)
)
(setq dn (cdr (assoc 2 (entget d))))
(setq db (tblobjname "BLOCK" dn))
(setq dt db)
(while (/= (cdr (assoc 0 (entget (setq dt (entnext dt))))) "MTEXT"))
(setq txt (cdr (assoc 1 (entget dt))))
(setq ang (substr txt (+ 2 (vl-string-search ";" txt))))
(setq txtn (strcat "\\A1;\\S" ang "^R" (rtos r 2 2) ";"))
(entmod (subst (cons 1 txtn) (assoc 1 (entget dt)) (entget dt)))
)
)
(*error* nil)
)Please, mark this topic as solution if it satisfies your needs...
Thanks, M.R.
Sir:
i really appreciate your response, sir as i try to use the lisp, there is a slight problem occurs, as i try to move the dimension to position it the dimension radius below disappears, and also the drawing temporarily adjust its ucs when dimensioning, hope we can do a little adjustment for this lisp,
thank so much again,
Ron
Only improvement to 3D DANR routine was to make it working with single pick in 3D space... UCS orientation that follows arced entity determines text dimension orientation and can't be changed... So if you are working in UCS rotated WCS - the same plane, I strongly suggest that you use my first posted code as orientation of text may be dependent on orientation of your custom oriented UCS...
New DANR.lsp for working in 3D you can find here :
HTH, M.R.
This is the best I could do, but still it depends on orientation of arced entity/sgement in 3D space...
(defun c:danr ( / *error* _plsegrad normucs el ss e p pe d dn db dt r txt txtn x xp )
(vl-load-com)
(defun *error* ( msg )
(if x (command "_.UCS" "_P"))
(if xp (command "_.UCS" "_P"))
(command "_.REGEN")
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(if msg (prompt msg))
(princ)
)
(defun _plsegrad ( obj pt / n p1 p2 bulge rad )
(setq n (fix (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj pt))))
(setq p1 (vlax-curve-getpointatparam obj (float n)))
(setq p2 (vlax-curve-getpointatparam obj (float (1+ n))))
(setq bulge (vla-getbulge obj (float n)))
(if (/= bulge 0.0)
(setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
)
(abs rad)
)
(defun normucs ( / v^v unit _ilp _ilpp ucs vd vx vxw vxn vxp vyp )
(vl-load-com)
(defun v^v ( u v )
(mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
)
(defun unit ( v )
(mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)
(defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
(if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
(progn
(setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
op (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
op (list (car op) (cadr op) (caddr p1p))
tp (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
)
(if (inters p1p p2p op tp nil)
(progn
(setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
p
)
nil
)
)
(progn
(setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
(setq p (trans pp nor 0))
p
)
)
)
(defun _ilpp ( p1 p2 t1 t2 t3 / nor o )
(setq nor (unit (v^v (mapcar '- t3 t1) (mapcar '- t2 t1))))
(setq o t1)
(if (_ilp p1 p2 o nor)
(_ilp p1 p2 o nor)
nil
)
)
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(1.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(0.0 1.0 0.0) 1 0)) "{ UCS }"))
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
(setq vd (getvar 'viewdir))
(if (minusp (caddr vd))
(progn
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(1.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(0.0 -1.0 0.0) 1 0)) "{ UCS }"))
(vla-put-activeucs (vla-get-activedocument (vlax-get-acad-object)) ucs)
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
(setq xp t)
)
)
(setq vd (getvar 'viewdir))
(if (not (equal (unit vd) '(0.0 0.0 1.0) 1e-6))
(progn
(if (equal (unit vd) (trans '(0.0 0.0 1.0) 0 1 t) 1e-6)
(setq vx (trans '(1.0 0.0 0.0) 0 1 t))
(progn
(setq vx (unit (v^v (unit vd) (trans '(0.0 0.0 1.0) 0 1 t))))
(setq vxw (trans vx 1 0))
(command "_.UCS" "_V")
(if (minusp (car (trans vxw 0 1)))
(setq vx (mapcar '- vx))
)
(command "_.UCS" "_P")
)
)
(setq vxn (mapcar '+ vx vd))
(setq vxp (_ilpp (trans vx 1 0) (trans vxn 1 0) (trans '(0.0 0.0 0.0) 1 0) (trans '(1.0 0.0 0.0) 1 0) (trans '(0.0 1.0 0.0) 1 0)))
(setq vxp (unit (trans vxp 0 1)))
(setq vyp (unit (v^v '(0.0 0.0 1.0) vxp)))
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans vxp 1 0)) (vlax-3d-point (trans vyp 1 0)) "{ UCS }"))
(vla-put-activeucs (vla-get-activedocument (vlax-get-acad-object)) ucs)
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
)
)
(princ)
)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq el (entlast))
(prompt "\nPick arced entity to dimension angular with radius value")
(setq ss (ssget "_+.:E:S" '((0 . "ARC,CIRCLE,*POLYLINE"))))
(while (null ss)
(prompt "\nMissed, empty sel.set... Try picking arced entity again (ARC,CIRCLE,*POLYLINE)...")
(setq ss (ssget "_+.:E:S" '((0 . "ARC,CIRCLE,*POLYLINE"))))
)
(setq e (ssname ss 0))
(setq p (cadr (cadddr (car (ssnamex ss)))))
(setq pe (vlax-curve-getclosestpointtoprojection e p '(0.0 0.0 1.0)))
(command "_.UCS" "_E" (trans pe 0 1))
(normucs)
(setq x t)
(command "_.DIMANGULAR" (trans pe 0 1))
(while (> (getvar 'cmdactive) 0) (command "\\"))
(setq d (entlast))
(if (not (equal d el))
(progn
(if (or (eq (cdr (assoc 0 (entget e))) "ARC") (eq (cdr (assoc 0 (entget e))) "CIRCLE"))
(setq r (cdr (assoc 40 (entget e))))
(if (eq (cdr (assoc 0 (entget e))) "POLYLINE")
(progn
(command "_.CONVERTPOLY" "_L" e "")
(setq r (_plsegrad (vlax-ename->vla-object e) pe))
(command "_.CONVERTPOLY" "_H" e "")
)
(setq r (_plsegrad (vlax-ename->vla-object e) pe))
)
)
(setq dn (cdr (assoc 2 (entget d))))
(setq db (tblobjname "BLOCK" dn))
(setq dt db)
(while (/= (cdr (assoc 0 (entget (setq dt (entnext dt))))) "MTEXT"))
(setq txt (cdr (assoc 1 (entget dt))))
(setq ang (substr txt (+ 2 (vl-string-search ";" txt))))
(setq txtn (strcat "\\A1;\\S" ang "^R" (rtos r 2 2) ";"))
(entmod (subst (cons 1 txtn) (assoc 1 (entget dt)) (entget dt)))
)
)
(*error* nil)
)Regards, M.R.
Please if this is what you're searching for, mark this as solution... I think that it can't be better than this, I've normalized UCS to best suit reading MTEXTs of dimension...
I have small mistake :
Replace in error handler this line :
(if x (command "_.UCS" "_P"))
With this line :
(if x (progn (command "_.UCS" "_P") (command "_.UCS" "_P")))
Sorry, for mistake - it doesn't allow me to edit my posted code...
M.R.
If I could only modify codes... Here is my last version and I think it won't be changed...
(defun c:danr ( / *error* _plsegrad normucs el ss e p pe d dn db dt r txt txtn u1 u2 u3 x xp )
(vl-load-com)
(defun *error* ( msg )
(if x (repeat x (command "_.UCS" "_P")))
(if xp (command "_.UCS" "_P"))
(command "_.REGEN")
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(if msg (prompt msg))
(princ)
)
(defun _plsegrad ( obj pt / n p1 p2 bulge rad )
(setq n (fix (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj pt))))
(setq p1 (vlax-curve-getpointatparam obj (float n)))
(setq p2 (vlax-curve-getpointatparam obj (float (1+ n))))
(setq bulge (vla-getbulge obj (float n)))
(if (/= bulge 0.0)
(setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
)
(abs rad)
)
(defun normucs ( / v^v unit _ilp _ilpp ucs vd vx vxw vxn vxp vyp )
(vl-load-com)
(defun v^v ( u v )
(mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
)
(defun unit ( v )
(mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)
(defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
(if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
(progn
(setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
op (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
op (list (car op) (cadr op) (caddr p1p))
tp (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
)
(if (inters p1p p2p op tp nil)
(progn
(setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
p
)
nil
)
)
(progn
(setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
(setq p (trans pp nor 0))
p
)
)
)
(defun _ilpp ( p1 p2 t1 t2 t3 / nor o )
(setq nor (unit (v^v (mapcar '- t3 t1) (mapcar '- t2 t1))))
(setq o t1)
(if (_ilp p1 p2 o nor)
(_ilp p1 p2 o nor)
nil
)
)
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(1.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(0.0 1.0 0.0) 1 0)) "{ UCS }"))
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
(setq vd (getvar 'viewdir))
(if (minusp (caddr vd))
(progn
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(1.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(0.0 -1.0 0.0) 1 0)) "{ UCS }"))
(vla-put-activeucs (vla-get-activedocument (vlax-get-acad-object)) ucs)
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
(setq xp t)
)
)
(setq vd (getvar 'viewdir))
(if (not (equal (unit vd) '(0.0 0.0 1.0) 1e-6))
(progn
(if (equal (unit vd) (trans '(0.0 0.0 1.0) 0 1 t) 1e-6)
(setq vx (trans '(1.0 0.0 0.0) 0 1 t))
(progn
(setq vx (unit (v^v (unit vd) (trans '(0.0 0.0 1.0) 0 1 t))))
(setq vxw (trans vx 1 0))
(command "_.UCS" "_V")
(if (minusp (car (trans vxw 0 1)))
(setq vx (mapcar '- vx))
)
(command "_.UCS" "_P")
)
)
(setq vxn (mapcar '+ vx vd))
(setq vxp (_ilpp (trans vx 1 0) (trans vxn 1 0) (trans '(0.0 0.0 0.0) 1 0) (trans '(1.0 0.0 0.0) 1 0) (trans '(0.0 1.0 0.0) 1 0)))
(setq vxp (unit (trans vxp 0 1)))
(setq vyp (unit (v^v '(0.0 0.0 1.0) vxp)))
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans vxp 1 0)) (vlax-3d-point (trans vyp 1 0)) "{ UCS }"))
(vla-put-activeucs (vla-get-activedocument (vlax-get-acad-object)) ucs)
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
)
)
(princ)
)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq el (entlast))
(prompt "\nPick arced entity to dimension angular with radius value")
(setq ss (ssget "_+.:E:S" '((0 . "ARC,CIRCLE,*POLYLINE"))))
(while (null ss)
(prompt "\nMissed, empty sel.set... Try picking arced entity again (ARC,CIRCLE,*POLYLINE)...")
(setq ss (ssget "_+.:E:S" '((0 . "ARC,CIRCLE,*POLYLINE"))))
)
(setq e (ssname ss 0))
(setq p (cadr (cadddr (car (ssnamex ss)))))
(setq pe (vlax-curve-getclosestpointtoprojection e p '(0.0 0.0 1.0)))
(setq u1 (list (trans '(1.0 0.0 0.0) 1 0 t) (trans '(0.0 1.0 0.0) 1 0 t) (trans '(0.0 0.0 1.0) 1 0 t)))
(if (not (or (equal '(210 0.0 0.0 1.0) (assoc 210 (entget e)) 1e-6) (equal '(210 0.0 0.0 -1.0) (assoc 210 (entget e)) 1e-6)))
(progn
(command "_.UCS" "_E" (trans pe 0 1))
(setq u2 (list (trans '(1.0 0.0 0.0) 1 0 t) (trans '(0.0 1.0 0.0) 1 0 t) (trans '(0.0 0.0 1.0) 1 0 t)))
(normucs)
(setq u3 (list (trans '(1.0 0.0 0.0) 1 0 t) (trans '(0.0 1.0 0.0) 1 0 t) (trans '(0.0 0.0 1.0) 1 0 t)))
(cond
( (and (equal u1 u2 1e-6) (equal u2 u3 1e-6))
(setq x 0)
)
( (or (and (not (equal u1 u2 1e-6)) (equal u2 u3 1e-6)) (and (equal u1 u2 1e-6) (not (equal u2 u3 1e-6))))
(setq x 1)
)
( (and (not (equal u1 u2 1e-6)) (not (equal u2 u3 1e-6)))
(setq x 2)
)
)
)
)
(command "_.DIMANGULAR" (trans pe 0 1))
(while (> (getvar 'cmdactive) 0) (command "\\"))
(setq d (entlast))
(if (not (equal d el))
(progn
(if (or (eq (cdr (assoc 0 (entget e))) "ARC") (eq (cdr (assoc 0 (entget e))) "CIRCLE"))
(setq r (cdr (assoc 40 (entget e))))
(if (eq (cdr (assoc 0 (entget e))) "POLYLINE")
(progn
(command "_.CONVERTPOLY" "_L" e "")
(setq r (_plsegrad (vlax-ename->vla-object e) pe))
(command "_.CONVERTPOLY" "_H" e "")
)
(setq r (_plsegrad (vlax-ename->vla-object e) pe))
)
)
(setq dn (cdr (assoc 2 (entget d))))
(setq db (tblobjname "BLOCK" dn))
(setq dt db)
(while (/= (cdr (assoc 0 (entget (setq dt (entnext dt))))) "MTEXT"))
(setq txt (cdr (assoc 1 (entget dt))))
(setq ang (substr txt (+ 2 (vl-string-search ";" txt))))
(setq txtn (strcat "\\A1;\\S" ang "^R" (rtos r 2 2) ";"))
(entmod (subst (cons 1 txtn) (assoc 1 (entget dt)) (entget dt)))
)
)
(*error* nil)
)HTH, M.R.
One more revision... Sorry for this, but I am constantly testing it and constantly finding lacks... Now should be fine for now...
(defun c:danr ( / *error* _plsegrad normucs el ss e p pe d dn db dt r txt txtn u1 u2 u3 x xp )
(vl-load-com)
(defun *error* ( msg )
(if x (repeat x (command "_.UCS" "_P")))
(if xp (command "_.UCS" "_P"))
(command "_.REGEN")
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(if msg (prompt msg))
(princ)
)
(defun _plsegrad ( obj pt / n p1 p2 bulge rad )
(setq n (fix (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj pt))))
(setq p1 (vlax-curve-getpointatparam obj (float n)))
(setq p2 (vlax-curve-getpointatparam obj (float (1+ n))))
(setq bulge (vla-getbulge obj (float n)))
(if (/= bulge 0.0)
(setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
)
(abs rad)
)
(defun normucs ( / v^v unit _ilp _ilpp ucs vd vx vxw vxn vxp vyp )
(vl-load-com)
(defun v^v ( u v )
(mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
)
(defun unit ( v )
(mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)
(defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
(if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
(progn
(setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
op (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
op (list (car op) (cadr op) (caddr p1p))
tp (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
)
(if (inters p1p p2p op tp nil)
(progn
(setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
p
)
nil
)
)
(progn
(setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
(setq p (trans pp nor 0))
p
)
)
)
(defun _ilpp ( p1 p2 t1 t2 t3 / nor o )
(setq nor (unit (v^v (mapcar '- t3 t1) (mapcar '- t2 t1))))
(setq o t1)
(if (_ilp p1 p2 o nor)
(_ilp p1 p2 o nor)
nil
)
)
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(1.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(0.0 1.0 0.0) 1 0)) "{ UCS }"))
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
(setq vd (getvar 'viewdir))
(if (minusp (caddr vd))
(progn
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(1.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(0.0 -1.0 0.0) 1 0)) "{ UCS }"))
(vla-put-activeucs (vla-get-activedocument (vlax-get-acad-object)) ucs)
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
(setq xp t)
)
)
(setq vd (getvar 'viewdir))
(if (not (equal (unit vd) '(0.0 0.0 1.0) 1e-6))
(progn
(if (equal (unit vd) (trans '(0.0 0.0 1.0) 0 1 t) 1e-6)
(setq vx (trans '(1.0 0.0 0.0) 0 1 t))
(progn
(setq vx (unit (v^v (unit vd) (trans '(0.0 0.0 1.0) 0 1 t))))
(setq vxw (trans vx 1 0))
(command "_.UCS" "_V")
(if (minusp (car (trans vxw 0 1)))
(setq vx (mapcar '- vx))
)
(command "_.UCS" "_P")
)
)
(setq vxn (mapcar '+ vx vd))
(setq vxp (_ilpp (trans vx 1 0) (trans vxn 1 0) (trans '(0.0 0.0 0.0) 1 0) (trans '(1.0 0.0 0.0) 1 0) (trans '(0.0 1.0 0.0) 1 0)))
(setq vxp (unit (trans vxp 0 1)))
(setq vyp (unit (v^v '(0.0 0.0 1.0) vxp)))
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans vxp 1 0)) (vlax-3d-point (trans vyp 1 0)) "{ UCS }"))
(vla-put-activeucs (vla-get-activedocument (vlax-get-acad-object)) ucs)
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
)
)
(princ)
)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq el (entlast))
(prompt "\nPick arced entity to dimension angular with radius value")
(setq ss (ssget "_+.:E:S" '((0 . "ARC,CIRCLE,*POLYLINE"))))
(while (null ss)
(prompt "\nMissed, empty sel.set... Try picking arced entity again (ARC,CIRCLE,*POLYLINE)...")
(setq ss (ssget "_+.:E:S" '((0 . "ARC,CIRCLE,*POLYLINE"))))
)
(setq e (ssname ss 0))
(setq p (cadr (cadddr (car (ssnamex ss)))))
(setq pe (vlax-curve-getclosestpointtoprojection e p '(0.0 0.0 1.0)))
(setq u1 (list (trans '(1.0 0.0 0.0) 1 0 t) (trans '(0.0 1.0 0.0) 1 0 t) (trans '(0.0 0.0 1.0) 1 0 t)))
(if (not (or (equal '(210 0.0 0.0 1.0) (assoc 210 (entget e)) 1e-6) (equal '(210 0.0 0.0 -1.0) (assoc 210 (entget e)) 1e-6)))
(progn
(command "_.UCS" "_E" (trans pe 0 1))
(setq u2 (list (trans '(1.0 0.0 0.0) 1 0 t) (trans '(0.0 1.0 0.0) 1 0 t) (trans '(0.0 0.0 1.0) 1 0 t)))
(normucs)
(setq u3 (list (trans '(1.0 0.0 0.0) 1 0 t) (trans '(0.0 1.0 0.0) 1 0 t) (trans '(0.0 0.0 1.0) 1 0 t)))
(cond
( (and (equal u1 u2 1e-6) (equal u2 u3 1e-6))
(setq x 0)
)
( (or (and (not (equal u1 u2 1e-6)) (equal u2 u3 1e-6)) (and (equal u1 u2 1e-6) (not (equal u2 u3 1e-6))))
(setq x 1)
)
( (and (not (equal u1 u2 1e-6)) (not (equal u2 u3 1e-6)))
(setq x 2)
)
)
)
(progn
(command "_.UCS" "_W")
(setq x 1)
)
)
(command "_.DIMANGULAR" (trans pe 0 1))
(while (> (getvar 'cmdactive) 0) (command "\\"))
(setq d (entlast))
(if (not (equal d el))
(progn
(if (or (eq (cdr (assoc 0 (entget e))) "ARC") (eq (cdr (assoc 0 (entget e))) "CIRCLE"))
(setq r (cdr (assoc 40 (entget e))))
(if (eq (cdr (assoc 0 (entget e))) "POLYLINE")
(progn
(command "_.CONVERTPOLY" "_L" e "")
(setq r (_plsegrad (vlax-ename->vla-object e) pe))
(command "_.CONVERTPOLY" "_H" e "")
)
(setq r (_plsegrad (vlax-ename->vla-object e) pe))
)
)
(setq dn (cdr (assoc 2 (entget d))))
(setq db (tblobjname "BLOCK" dn))
(setq dt db)
(while (/= (cdr (assoc 0 (entget (setq dt (entnext dt))))) "MTEXT"))
(setq txt (cdr (assoc 1 (entget dt))))
(setq ang (substr txt (+ 2 (vl-string-search ";" txt))))
(setq txtn (strcat "\\A1;\\S" ang "^R" (rtos r 2 2) ";"))
(entmod (subst (cons 1 txtn) (assoc 1 (entget dt)) (entget dt)))
)
)
(*error* nil)
)M.R.
Hi Ron,
This code will allow you to add the arc radius to existing angular dimensions in modelspace and paperspace.
If you want to include the arc length then remove the semi-colon from the appropriate line.
The arc length is suffixed to the default dimension text (i.e. "<>") and will not be reset if you reposition the dimension line or dimension text.
If the geometry is changed for the dimension then you will have to rerun the program on the changed dimensions to update the arc radius and arc length values.
Please note that the dimension text value will always be reset to the default value of "<>".
If you need to add the arc radius to a user input dimension text value then please feel free to let me know and I will add the option.
I hope this helps you.
Regards,
Trevor
(defun c:danr
(/
Arc_Length
Arc_Radius
assoc_360
Dict_DXF
DimAng_DXF
DimAng_ename
DIMASSOC_DXF
DimAng_3
DimAng_13
DimAng_14
DimAng_15
DimAng_42
DIMLFAC
Dimstyle_DXF
DimStyle_144
DimStyle_40
member_list
ssC
ss_DimAngular
ss_Filter
sv_cvport
TextString
Viewport_DXF
Viewport_ename
Viewport_41
Viewport_45
ZoomXP
)
(setq ss_Filter
(list
'(0 . "DIMENSION")
'(-4 . "&=")
'(70 . 37)
);list
);setq
(setq sv_cvport (getvar 'CVPORT))
(if (= sv_cvport 1)
(setq ss_Filter (append ss_Filter (list (cons 410 (getvar 'CTAB)))))
(setq ss_Filter (append ss_Filter '((410 . "Model"))))
);if (= sv_cvport 1)
(setq ss_DimAngular (ssget ss_Filter))
(cond
((not ss_DimAngular)
(princ "\nNo Angular Dimensions selected")
);(not ss_DimAngular)
(ss_DimAngular
(setq ssC -1)
(repeat (sslength ss_DimAngular)
(setq DimAng_ename (ssname ss_DimAngular (setq ssC (1+ ssC)))
DimAng_DXF (entget DimAng_ename)
DimAng_13 (cdr (assoc 13 DimAng_DXF)) ; Definition point for linear and angular dimensions (in WCS)
DimAng_14 (cdr (assoc 14 DimAng_DXF)) ; Definition point for linear and angular dimensions (in WCS)
DimAng_15 (cdr (assoc 15 DimAng_DXF)) ; Definition point for diameter, radius, and angular dimensions (in WCS)
DimAng_42 (cdr (assoc 42 DimAng_DXF)) ; Actual measurement
DimAng_3 (cdr (assoc 3 DimAng_DXF)) ; Dimension style name
Dimstyle_DXF (tblsearch "DIMSTYLE" DimAng_3)
DimStyle_40 (cdr (assoc 40 Dimstyle_DXF)) ; DIMSCALE
DimStyle_144 (cdr (assoc 144 Dimstyle_DXF)) ; DIMLFAC
DIMLFAC DimStyle_144 ; Default value
);setq
;; Determine value for DIMLFAC variable IF dimension is associative.
(cond
((not (zerop DimStyle_40))) ; Use default value for variable DIMLFAC.
((not (setq assoc_360 (assoc 360 DimAng_DXF))))
((not (setq Dict_DXF (entget (cdr assoc_360)))))
((not (setq member_list (member '(3 . "ACAD_DIMASSOC") Dict_DXF))))
((not (setq assoc_360 (assoc 360 member_list))))
((not (setq DIMASSOC_DXF (entget (cdr assoc_360)))))
((not (setq member_list (member '(1 . "AcDbOsnapPointRef") DIMASSOC_DXF))))
(member_list
(setq Viewport_ename (cdr (assoc 331 member_list))
Viewport_DXF (entget Viewport_ename)
Viewport_41 (cdr (assoc 41 Viewport_DXF)) ; Height in paper space units
Viewport_45 (cdr (assoc 45 Viewport_DXF)) ; View height (in model space units)
ZoomXP (/ Viewport_41 Viewport_45)
DIMLFAC (/ 1.0 ZoomXP)
);setq
);member_list
);cond
(setq Arc_Radius (* (distance DimAng_13 DimAng_15) DIMLFAC)
Arc_Length (* (/ DimAng_42 pi) (* pi Arc_Radius))
TextString "<>"
TextString (strcat TextString "\\XR=" (rtos Arc_Radius 2 2))
; TextString (strcat TextString "\\PL=" (rtos Arc_Length 2 2)) ; Arc Length option.
DimAng_DXF (subst (cons 1 TextString) (assoc 1 DimAng_DXF) DimAng_DXF)
);setq
(entmod DimAng_DXF)
(entupd DimAng_ename)
);repeat (sslength ss_DimAngular)
);ss_DimAngular
);cond
(princ)
);c:danr
A little change - just for making sure you picked arced entity/segment...
(defun c:danr ( / *error* _plsegrad normucs el ss e p pa pe d dn db dt r txt txtn u1 u2 u3 x xp )
(vl-load-com)
(defun *error* ( msg )
(if x (repeat x (command "_.UCS" "_P")))
(if xp (command "_.UCS" "_P"))
(command "_.REGEN")
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(if msg (prompt msg))
(princ)
)
(defun _plsegrad ( obj pt / n p1 p2 bulge rad )
(setq n (fix (vlax-curve-getparamatpoint obj (vlax-curve-getclosestpointto obj pt))))
(setq p1 (vlax-curve-getpointatparam obj (float n)))
(setq p2 (vlax-curve-getpointatparam obj (float (1+ n))))
(setq bulge (vla-getbulge obj (float n)))
(if (/= bulge 0.0)
(setq rad (/ (distance p1 p2) (* 2 (sin (* 2 (atan bulge))))))
)
(abs rad)
)
(defun normucs ( / v^v unit _ilp _ilpp ucs vd vx vxw vxn vxp vyp )
(defun v^v ( u v )
(mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
)
(defun unit ( v )
(mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)
(defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
(if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
(progn
(setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
op (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
op (list (car op) (cadr op) (caddr p1p))
tp (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
)
(if (inters p1p p2p op tp nil)
(progn
(setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
p
)
nil
)
)
(progn
(setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
(setq p (trans pp nor 0))
p
)
)
)
(defun _ilpp ( p1 p2 t1 t2 t3 / nor o )
(setq nor (unit (v^v (mapcar '- t3 t1) (mapcar '- t2 t1))))
(setq o t1)
(if (_ilp p1 p2 o nor)
(_ilp p1 p2 o nor)
nil
)
)
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(1.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(0.0 1.0 0.0) 1 0)) "{ UCS }"))
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
(setq vd (getvar 'viewdir))
(if (minusp (caddr vd))
(progn
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(1.0 0.0 0.0) 1 0)) (vlax-3d-point (trans '(0.0 -1.0 0.0) 1 0)) "{ UCS }"))
(vla-put-activeucs (vla-get-activedocument (vlax-get-acad-object)) ucs)
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
(setq xp t)
)
)
(setq vd (getvar 'viewdir))
(if (not (equal (unit vd) '(0.0 0.0 1.0) 1e-6))
(progn
(if (equal (unit vd) (trans '(0.0 0.0 1.0) 0 1 t) 1e-6)
(setq vx (trans '(1.0 0.0 0.0) 0 1 t))
(progn
(setq vx (unit (v^v (unit vd) (trans '(0.0 0.0 1.0) 0 1 t))))
(setq vxw (trans vx 1 0))
(command "_.UCS" "_V")
(if (minusp (car (trans vxw 0 1)))
(setq vx (mapcar '- vx))
)
(command "_.UCS" "_P")
)
)
(setq vxn (mapcar '+ vx vd))
(setq vxp (_ilpp (trans vx 1 0) (trans vxn 1 0) (trans '(0.0 0.0 0.0) 1 0) (trans '(1.0 0.0 0.0) 1 0) (trans '(0.0 1.0 0.0) 1 0)))
(setq vxp (unit (trans vxp 0 1)))
(setq vyp (unit (v^v '(0.0 0.0 1.0) vxp)))
(setq ucs (vla-add (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (trans '(0.0 0.0 0.0) 1 0)) (vlax-3d-point (trans vxp 1 0)) (vlax-3d-point (trans vyp 1 0)) "{ UCS }"))
(vla-put-activeucs (vla-get-activedocument (vlax-get-acad-object)) ucs)
(command "_.UCS" "_D" "{ UCS }")
(vlax-release-object ucs)
)
)
(princ)
)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq el (entlast))
(prompt "\nPick arced entity to dimension angular with radius value")
(setq ss (ssget "_+.:E:S" '((0 . "ARC,CIRCLE,*POLYLINE"))))
(if (and ss (wcmatch (cdr (assoc 0 (entget (ssname ss 0)))) "*POLYLINE"))
(progn
(setq pe (vlax-curve-getclosestpointtoprojection (ssname ss 0) (cadr (cadddr (car (ssnamex ss)))) '(0.0 0.0 1.0)))
(setq pa (vlax-curve-getparamatpoint (ssname ss 0) pe))
(if (= (vla-getbulge (vlax-ename->vla-object (ssname ss 0)) (float (fix pa))) 0.0)
(setq ss nil)
)
)
)
(while (null ss)
(prompt "\nMissed, empty sel.set or picked straight polyline segment... Try picking only arced entity/segment again (ARC,CIRCLE,*POLYLINE)...")
(setq ss (ssget "_+.:E:S" '((0 . "ARC,CIRCLE,*POLYLINE"))))
(if (and ss (wcmatch (cdr (assoc 0 (entget (ssname ss 0)))) "*POLYLINE"))
(progn
(setq pe (vlax-curve-getclosestpointtoprojection (ssname ss 0) (cadr (cadddr (car (ssnamex ss)))) '(0.0 0.0 1.0)))
(setq pa (vlax-curve-getparamatpoint (ssname ss 0) pe))
(if (= (vla-getbulge (vlax-ename->vla-object (ssname ss 0)) (float (fix pa))) 0.0)
(setq ss nil)
)
)
)
)
(setq e (ssname ss 0))
(setq p (cadr (cadddr (car (ssnamex ss)))))
(setq pe (vlax-curve-getclosestpointtoprojection e p '(0.0 0.0 1.0)))
(setq u1 (list (trans '(1.0 0.0 0.0) 1 0 t) (trans '(0.0 1.0 0.0) 1 0 t) (trans '(0.0 0.0 1.0) 1 0 t)))
(if (not (or (equal '(210 0.0 0.0 1.0) (assoc 210 (entget e)) 1e-6) (equal '(210 0.0 0.0 -1.0) (assoc 210 (entget e)) 1e-6)))
(progn
(command "_.UCS" "_E" (trans pe 0 1))
(setq u2 (list (trans '(1.0 0.0 0.0) 1 0 t) (trans '(0.0 1.0 0.0) 1 0 t) (trans '(0.0 0.0 1.0) 1 0 t)))
(normucs)
(setq u3 (list (trans '(1.0 0.0 0.0) 1 0 t) (trans '(0.0 1.0 0.0) 1 0 t) (trans '(0.0 0.0 1.0) 1 0 t)))
(cond
( (and (equal u1 u2 1e-6) (equal u2 u3 1e-6))
(setq x 0)
)
( (or (and (not (equal u1 u2 1e-6)) (equal u2 u3 1e-6)) (and (equal u1 u2 1e-6) (not (equal u2 u3 1e-6))))
(setq x 1)
)
( (and (not (equal u1 u2 1e-6)) (not (equal u2 u3 1e-6)))
(setq x 2)
)
)
)
(progn
(command "_.UCS" "_W")
(setq x 1)
)
)
(command "_.DIMANGULAR" (trans pe 0 1))
(while (> (getvar 'cmdactive) 0) (command "\\"))
(setq d (entlast))
(if (not (equal d el))
(progn
(if (or (eq (cdr (assoc 0 (entget e))) "ARC") (eq (cdr (assoc 0 (entget e))) "CIRCLE"))
(setq r (cdr (assoc 40 (entget e))))
(if (eq (cdr (assoc 0 (entget e))) "POLYLINE")
(progn
(command "_.CONVERTPOLY" "_L" e "")
(setq r (_plsegrad (vlax-ename->vla-object e) pe))
(command "_.CONVERTPOLY" "_H" e "")
)
(setq r (_plsegrad (vlax-ename->vla-object e) pe))
)
)
(setq dn (cdr (assoc 2 (entget d))))
(setq db (tblobjname "BLOCK" dn))
(setq dt db)
(while (/= (cdr (assoc 0 (entget (setq dt (entnext dt))))) "MTEXT"))
(setq txt (cdr (assoc 1 (entget dt))))
(setq ang (substr txt (+ 2 (vl-string-search ";" txt))))
(setq txtn (strcat "\\A1;\\S" ang "^R" (rtos r 2 2) ";"))
(entmod (subst (cons 1 txtn) (assoc 1 (entget dt)) (entget dt)))
)
)
(*error* nil)
)
Hi Ron,
I've had a second pass on my code and fine tuned a few items.
Regards,
Trevor
(defun c:danr
(/
Arc_Length
Arc_Radius
assoc_360
Dict_ename
DimAng_DXF
DimAng_ename
DimAng_1
DimAng_3
DimAng_13
DimAng_14
DimAng_15
DimAng_42
DIMASSOC_DXF
DIMLFAC
Dimstyle_DXF
DimStyle_144
DimStyle_40
member_list
ssC
ss_DimAngular
ss_Filter
sv_cvport
TextString
Viewport_DXF
Viewport_ename
Viewport_41
Viewport_45
ZoomXP
)
(setq ss_Filter
(list
'(0 . "DIMENSION")
'(-4 . "&=")
'(70 . 37)
);list
);setq
(setq sv_cvport (getvar 'CVPORT))
(if (= sv_cvport 1)
(setq ss_Filter (append ss_Filter (list (cons 410 (getvar 'CTAB)))))
(setq ss_Filter (append ss_Filter '((410 . "Model"))))
);if (= sv_cvport 1)
(setq ss_DimAngular (ssget ss_Filter))
(cond
((not ss_DimAngular)
(princ "\nNo Angular Dimensions selected")
);(not ss_DimAngular)
(ss_DimAngular
(setq ssC -1)
(repeat (sslength ss_DimAngular)
(setq DimAng_ename (ssname ss_DimAngular (setq ssC (1+ ssC)))
DimAng_DXF (entget DimAng_ename)
DimAng_1 (cdr (assoc 1 DimAng_DXF)) ; Dimension text explicitly entered by the user
DimAng_13 (cdr (assoc 13 DimAng_DXF)) ; Definition point for linear and angular dimensions (in WCS)
DimAng_14 (cdr (assoc 14 DimAng_DXF)) ; Definition point for linear and angular dimensions (in WCS)
DimAng_15 (cdr (assoc 15 DimAng_DXF)) ; Definition point for diameter, radius, and angular dimensions (in WCS)
DimAng_42 (cdr (assoc 42 DimAng_DXF)) ; Actual measurement
DimAng_3 (cdr (assoc 3 DimAng_DXF)) ; Dimension style name
Dimstyle_DXF (tblsearch "DIMSTYLE" DimAng_3)
DimStyle_40 (cdr (assoc 40 Dimstyle_DXF)) ; DIMSCALE
DimStyle_144 (cdr (assoc 144 Dimstyle_DXF)) ; DIMLFAC
;; Use DIMLFAC as multiplier for arc radius and arc length.
DIMLFAC DimStyle_144 ; Default value
);setq
;; Determine value for DIMLFAC variable IF dimension is associative.
(cond
((not (zerop DimStyle_40))) ; Use default value for variable DIMLFAC.
((not (setq assoc_360 (assoc 360 DimAng_DXF)))) ; Check for extension dictionary.
((not (setq Dict_ename (cdr assoc_360))))
((not (setq DIMASSOC_DXF (dictsearch Dict_ename "ACAD_DIMASSOC")))) ; Search extension dictionary for dimension associativity data.
((not (setq member_list (member '(1 . "AcDbOsnapPointRef") DIMASSOC_DXF))))
(member_list
(setq Viewport_ename (cdr (assoc 331 member_list)) ; Paperspace viewport entity name that dimension is associated with for scaling of dimension value.
Viewport_DXF (entget Viewport_ename)
Viewport_41 (cdr (assoc 41 Viewport_DXF)) ; Height in paper space units
Viewport_45 (cdr (assoc 45 Viewport_DXF)) ; View height (in model space units)
ZoomXP (/ Viewport_41 Viewport_45)
DIMLFAC (/ 1.0 ZoomXP)
);setq
);member_list
);cond
(setq Arc_Radius (* (distance DimAng_13 DimAng_15) DIMLFAC)
Arc_Length (* DimAng_42 Arc_Radius)
TextString "<>"
TextString (strcat TextString "\\XR=" (rtos Arc_Radius 2 2))
; TextString (strcat TextString "\\PL=" (rtos Arc_Length 2 2)) ; Arc Length option.
DimAng_DXF (subst (cons 1 TextString) (assoc 1 DimAng_DXF) DimAng_DXF)
);setq
(entmod DimAng_DXF)
(entupd DimAng_ename)
);repeat (sslength ss_DimAngular)
);ss_DimAngular
);cond
(princ)
);c:danr
hi sir, i found your lisp very usefull, thank you so much. Anyway sir, i found one lisp which is also functions the same. the only problem with this lisp is that when i try use the routine in layout it gives incorrect radius dimension, see my attached image, we are likely dimensioning our drawing in layout so thats why it would be a great help if you can correct this lisp that i can also use this in layout.. hope u can do your magic with this lisp.
Thanking you so much,
Ron
;;; Dimangular/Radius
;;; for landscape drawings
;;;
;;; By hrr
;;; 08152004
;;;
;;; Last Modify : 15aug2004
;;;
;;;
;;;(/ dlf osn pnt p1 p2 c1 c2 c3 c4 c5)
;;;(setvar "dimstyle" "r" "ARR" "")
(defun c:dx ()
(setq dlf 1)
(setq osn (getvar "osmode"))
(command "osmode" "512")
(setq pnt (getpoint "pick arc: "))
(command "line" "_cen" pnt pnt "")
(setq p1 (cdr (assoc 10 (entget (entlast)))))
(setq p2 (cdr (assoc 11 (entget (entlast)))))
(command "erase" "l" "" "")
(setq c1 (atoi (rtos (* dlf (distance p1 p2)))))
;(setq c2 (atoi (rtos (* c1 0.01))))
(setq z1 (* (atoi (rtos (* c1 0.1))) 10))
(setq z2 (if (< (- c1 z1) 5) (setq z3 0) (setq z3 10)))
(setq c4 "<> R")
(setq z4 (+ z1 z3))
(setq z5 (rtos z4))
(setq c5 (strcat c4 z5))
(command "_dimangular" pnt "t" c5 pause)
(command ".chprop" "last" "" "la" "La-dim" "")
(command ".chprop" "last" "" "c" "bylayer" "")
(command ".chprop" "last" "" "lt" "bylayer" "")
(setvar "osmode" 175 )
(command "osnap" "end,int,mid" ""))
(defun c:dxx ()
(setq dlf 1)
(setq osn (getvar "osmode"))
(command "osmode" "512")
(setq pnt (getpoint "pick arc: "))
(command "line" "_cen" pnt pnt "")
(setq p1 (cdr (assoc 10 (entget (entlast)))))
(setq p2 (cdr (assoc 11 (entget (entlast)))))
(command "erase" "l" "" "")
(setq c1 (atoi (rtos (* dlf (distance p1 p2)))))
;(setq c2 (atoi (rtos (* c1 0.01))))
(setq z1 (* (atoi (rtos (* c1 0.1))) 10))
(setq z2 (if (< (- c1 z1) 5) (setq z3 0) (setq z3 10)))
(setq c4 "<>\\XR")
(setq z4 (+ z1 z3))
(setq z5 (rtos z4))
(setq c5 (strcat c4 z5))
(command "_dimangular" pnt "t" c5 pause)
(command ".chprop" "last" "" "la" "la-dim" "")
(command ".chprop" "last" "" "c" "bylayer" "")
(command ".chprop" "last" "" "lt" "bylayer" "")
(setvar "osmode" 175 )
(command "osnap" "end,int,mid" ""))
and also give the dimension radius which is not round off, please also adjust the round off seetings to the second demical point as to 00.05,
thank you again,
Ron
Hi Ron,
You're welcome and thank you for the kudo.
The angle value of Angular dimensions do not require a scale factor as opposed to linear dimensions which return a distance which has to be scaled to suit the Zoom XP factor of the Paperspace viewport.
Angles are not scaled.
This feature of Angular dimensions means that any dimension style with any scale factor can be used to place Angular dimensions in a Paperspace layout albeit not good practice to do so.
The code you provided can be modified to return the correctly scaled Radius and Arc Length but it is dependent on having the correct dimension style current with DIMSCALE, DIMLFAC etc. configured correctly and the dimension text value changed after placing the dimension.
At the moment the code is providing the dimension text value with the suffixed Radius value during placement of the Angular dimension.
The Radius value is not scaled correctly as it is the length of the line drawn in Paperspace.
As per my code, the Arc length and Radius can be calculated from the Angular dimension setout points after it is placed, but not during placement.
If the current dimension style is configured correctly, then it can be queried to determine the scaling factor to apply to the Radius and Arc Length values calculated from the setout points.
If the selected dimension is NOT associative, my code is still dependent on the dimension style of the selected Angular dimension to be configured with the correct values for DIMSCALE, DIMLFAC etc..
Associative dimensions are actually easier to query for the correct scale factor because a link to the Paperspace viewport is saved with the dimension and the scale factor calculated from the Paperspace viewport Zoom XP factor and not the DIMSCALE or DIMLFAC values of the dimension style.
At the moment, my code does not take into account dimension Overrides i.e. DIMLFAC or DIMSCALE which can be applied to the dimension.
The dimension style used to place dimensions in a Paperspace layout will have to be configured to be one of the following:
If there are multiple Paperspace viewports using different Zoom XP factors then a dimension style for each will be required.
I hope my explanation makes sense.
Regards,
Trevor
hi,
can you make lisp for angular dimension in closed polyline?
@Anonymous wrote:
....
can you make lisp for angular dimension in closed polyline?
That seemed like a useful thing [and not just for closed Polylines], so I worked something up [stealing a lot from a routine I have that Dimensions the lengths of all segments] -- see the attached DimPolyAngles.lsp with its DPLA command. Read the comments at the top of the file, and some within the code. It's rather lightly tested, but it seems to work. [However, I'm at my older-version location at the moment, so I hope the DimAngular command hasn't changed in newer versions in any way that makes DPLA not work -- I can try to fix any when I can get into a newer version.]
thank you very much. 🙂
it's helped me a lot.
@hiraram_prajapati wrote:
Ange is coming opposite side, can you update with Flow direction right side angle, please
Show us what you mean with an image or sample drawing, including both what the command does and what you want it to do instead. It works as intended for me, with Polylines drawn in either direction, if that's what you mean by "Flow direction."
