(vl-load-com)
(defun c:cet ( / js htx AcDoc Space nw_style n obj ename pr pt deriv rtx nw_obj)
(princ "\nSelect polylines: ")
(setq js
(ssget
(list
'(0 . "LWPOLYLINE")
(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
)
)
)
(cond
(js
(initget 6)
(setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify text height : ")))
(if htx (setvar "TEXTSIZE" htx))
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
)
(cond
((null (tblsearch "LAYER" "Label Elevation"))
(vlax-put (vla-add (vla-get-layers AcDoc) "Label Elevation") 'color 96)
)
)
(cond
((null (tblsearch "STYLE" "Romand-Label"))
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label"))
(mapcar
'(lambda (pr val)
(vlax-put nw_style pr val)
)
(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
(list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
)
)
)
(repeat (setq n (sslength js))
(setq
obj (ssname js (setq n (1- n)))
ename (vlax-ename->vla-object obj)
pt (vlax-curve-GetpointAtParam ename (setq pr (* 0.5 (vlax-curve-getEndParam ename))))
deriv (vlax-curve-getFirstDeriv ename pr)
rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
)
(if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
(setq nw_obj
(vla-addMtext Space
(vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))))
0.0
(strcat
"%<\\AcObjProp Object(%vla-object obj)))
">%).Elevation \\f \"%lu2%pr0\">%"
)
)
)
(mapcar
'(lambda (pr val)
(vlax-put nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
(list 5 (getvar "TEXTSIZE") 5 pt "Romand-Label" "Label Elevation" rtx)
)
)
)
)
(prin1)
)
(c:cet)

Advertisements