Topic: Object Data

[MSTG007]

I stumbled on to a routine Augi that can label Object data.

http://forums.augi.com/showthread.php?60054-LISP-Routine-to-get-Object-Data

It labels the object data by selecting the polyline. Then place the text in a location.

My question, is there a way that I can select the polyline and then the text stays aligned to the where it was picked? I guess it would be similar to Lee's Dynamic Align routine.

I'll keep messing around. Thanks for any input.

Code: [Select]

(defun c:Route() 
              (setq ss1 (ssget ":S"))
              (setq count 0)
              (setq lgh (sslength ss1))     
              (while  (< count lgh)
                 (setq x (ssname ss1 count)
                       e (entget x)
apn  (apnhelper (ade_odgetfield x "Roads_2015_INDOT_IN" "ROUTE_NAME" 0))
                 )
                 (setq textpt (getpoint "\nText Location: "))
                 (command "text" "m" textpt "" apn)
                 (setq lgh (- lgh 1))
                 (princ)
              )         
)

(c:Route)

[tombu]

Some examples: http://forums.augi.com/showthread.php?137045-Contour-elevation-labelling-help

[MSTG007]

Thank you for sharing that link. That does get me a lot closer to what I was trying to get at. I do have a question. In the options of this routine. In the image with the command line. I have an option that shows ROUTE_Number and ROUTE_ID. It would be nice if I can make it the whole object data tag for the selection. I can not seem to see where it is I can change that within the routine.

The below lisp was found here.

http://forums.augi.com/showthread.php?137045-Contour-elevation-labelling-help

Code: [Select]

(vl-load-com)
(defun c:OD2Label_Side ( / js obj ename htx AcDoc Space nw_style lst_tabl_def lst_def desc_od str msg pt deriv rtx  nw_obj dxf_ent tmp)
;; (princ "\nSélectionnez une polyligne.")
(princ "\nSelect a polyline.")
(while
(null
(setq js
(ssget "_+.:E:S"
(list
'(0 . "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE")
(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
)
)
)
)
;; (princ "\nCe n'est pas un objet valable pour cette fonction!")
(princ "\nThis selection is not avalible.")
)
(setq
obj (ssname js 0)
ename (vlax-ename->vla-object obj)
)
(cond
((ade_odgettables obj)
(initget 6)
;; (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: ")))
(setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify the height of text <" (rtos (getvar "TEXTSIZE")) ">: ")))
(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" "C_MAP_TEXT")) ;;Chage Layer
(vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 1) ;;Change Layer Color
)
)
(cond
((null (tblsearch "STYLE" "L80")) ;;Change Text Style
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "L80"))
(mapcar
'(lambda (pr val)
(vlax-put nw_style pr val)
)
(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
(list "simplex.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
)
)
)
(setq lst_tabl_def (mapcar 'ade_odtabledefn (ade_odgettables obj)))
(foreach n lst_tabl_def
(foreach el n
(if (listp (cdr el))
(foreach sel (cdr el)
(foreach msel sel
(if (eq (car msel) "ColName")
(setq lst_def (cons (strcase (cdr msel)) lst_def))
)
)
)
)
)
)
(setq msg "")
(initget (foreach n lst_def (setq msg (strcat n " " msg))))
(setq msg "")
;; (setq msg (strcat "\nDescription de la donnée d'objet? [" (foreach n lst_def (setq msg (strcat n "/" msg))) "]"))
(setq msg (strcat "\nSelect Object Data Field for Label. [" (foreach n lst_def (setq msg (strcat n "/" msg))) "]"))
(while (not (member (setq desc_od (strcase (getkword msg))) lst_def))
;; (princ "\nCette description n'est pas présente dans la table")
(princ "\nThis description is not in the table.")
)
(setq str (ade_odgetfield obj (car(ade_odgettables obj)) desc_od 0))
(setq nw_obj
(vla-addMtext Space
(vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE"))))
(setq rtx 0.0)
str
)
)
(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" rtx)
)
(setq dxf_ent (entget (entlast)))
(while (or (= 5 (car (setq tmp (grread t 5 1)))) (/= (car tmp) 25) (= (car tmp) 3))
(cond
((= 5 (car tmp))
(setq
pt (vlax-curve-getClosestPointTo ename (trans (cadr tmp) 1 0))
deriv (vlax-curve-getFirstDeriv ename (vlax-curve-GetParamAtPoint ename pt))
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)))
(entmod
(subst
(cons 50 rtx)
(assoc 50 dxf_ent)
(subst (cons 10 (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))) (assoc 10

dxf_ent) dxf_ent)
)
)
(entupd (cdar dxf_ent))
)
((= 3 (car tmp))
(setq nw_obj
(vla-addMtext Space
(vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE"))))
(setq rtx 0.0)
str
)
)
(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" rtx)
)
(setq dxf_ent (entget (entlast)))
)
;; (T (princ "\nArrêt anormal de la commande "))
(T (princ "\nError Terminating routine. "))
)
)
(entdel (entlast))
)
(T (princ "\nPas de données d'objet attachées"))
)
(prin1)
)
(c:OD2Label_Side)
Thanks for any help!