Info : Creates Distance Text to Selected Polylines , Lwpolyline and Line
(defun c:mse (/ *error* adoc space sset i ang e en p s nd _Text c pp p1
p2)
(vl-load-com)
(defun *error* (x)
(if adoc
(vla-endundomark adoc)
)
(cond ((not x))
((member x '("Function cancelled" "quit / exit abort")))
((princ (strcat "\n----> Error:" x)))
)
(princ)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq space (vla-get-modelspace adoc))
(vla-startundomark adoc)
(prompt "\nSelect LINE,POLYLINES,LWPOLYLINES")
(if (setq sset (ssget "_:L"
'((-4 . "<Or")
(0 . "LINE")
(0 . "LWPOLYLINE")
(0 . "POLYLINE")
(-4 . "Or>")
)
)
)
(progn
(defun ang (a b / ang1)
(setq ang1 (atof (angtos (angle a b))))
(if
(and
(>= ang1 90.0)
(<= ang1 273.0)
)
(angle b a)
(angle a b)
)
)
(repeat (setq i (sslength sset))
(setq e (ssname sset (setq i (1- i))))
(setq en (entget e))
(if (= "LINE" (cdr (assoc 0 en)))
(progn (setq s (cdr (assoc 10 en)))
(setq nd (cdr (assoc 11 en)))
(setq p (mapcar
(function (lambda (a b) (/ (+ a b) 2.))
)
s
nd
)
)
(setq _Text (vla-addtext
space
(rtos (distance s nd))
(vlax-3d-point p)
2.0
)
)
(vla-put-alignment
_Text
acalignmentbottomcenter
)
(vla-put-TextAlignMentPoint
_Text
(vlax-3d-point p)
)
(vla-put-Rotation _Text (ang s nd))
)
(progn (setq c 0)
(repeat (- (fix (vlax-curve-getendparam e))
(fix (vlax-curve-getstartparam e))
)
(setq pp (mapcar
(function
(lambda (a b) (/ (+ a b) 2.))
)
(setq p1 (vlax-curve-getpointatparam
e
c
)
)
(setq p2 (vlax-curve-getpointatparam
e
(setq c (1+ c))
)
)
)
)
(setq _Text (vla-addtext
space
(rtos (distance p1 p2))
(vlax-3d-point pp)
2.0
)
)
(vla-put-alignment
_Text
acalignmentbottomcenter
)
(vla-put-TextAlignMentPoint
_Text
(vlax-3d-point pp)
)
(vla-put-Rotation _Text (ang p1 p2))
)
)
)
)
)
)
(*error* nil)
(vla-endundomark adoc)
(vlax-release-object adoc)
(princ)
)
0 comments:
Post a Comment