Hi, guys
I have to align multiple texts to a polyline. And I've found a great lisp from Mark S. Thomas.
But the problem the code allow selection just a single text.
Can anybody help me add, "selection multiple texts" in this code, please?
I wish this lisp had 2 options: single and multiple.
Thank in advance.
(defun c:rrt (/
; local functions
getSegment get-opp-ang undobegin undoend
; local variables
ent txt_ent obj txt_obj obj_typ ang ans
)
;;; FUNCTION
;;; rotates the user selected (M)TEXT to the user selected
;;; entity. valid entites are light weight plines, lines
;;; and (m)text. you are given the chance to rotate the
;;; by 180 degrees after intial rotation.
;;;
;;; ARGUMENTS
;;; none
;;;
;;; USAGE
;;; enter RRT on the comand line
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2004 Mark S. Thomas
;;; mark_AT_theswamp.org
;;;
;;; VERSION
;;; 1.0 Tue Dec 07, 2004
;;; 1.1 Tue Dec 21, 2004 ; added ARC types
;;; 1.1a Tue Dec 21, 2004 ; reversed the pick order
;;;
;;; TODO:
;;; handle text that has 'fit' justification
;;; add more entites for angle extraction
;;; more testing
(vl-load-com)
;; credit Stig Madsen
;; refer to thread titled "relaxed-curves" under the "Teach Me"
;; section of TheSwamp at www.theswamp.org/phpBB2/
(defun getSegment (obj pt / cpt eParam stParam)
(cond ((setq cpt (vlax-curve-getClosestPointTo obj pt))
(setq eParam (fix (vlax-curve-getEndParam obj)))
(if (= eParam (setq stParam (fix (vlax-curve-getParamAtPoint obj cpt))))
(setq stParam (1- stParam))
(setq eParam (1+ stParam))
)
(list eParam (vlax-curve-getPointAtParam obj stParam)
(vlax-curve-getPointAtParam obj eParam))
)
)
)
;; undo functions
(defun undobegin ()
(vla-EndUndoMark
(vlax-get-property
(vlax-get-acad-object)
'ActiveDocument
)
)
(vla-StartUndoMark
(vlax-get-property
(vlax-get-acad-object)
'ActiveDocument
)
)
)
(defun undoend ()
(vla-EndUndoMark
(vlax-get-property
(vlax-get-acad-object)
'ActiveDocument
)
)
)
;; returns the oppsite of an angle define in radians
(defun get-opp-ang (ang)
(cond ((< ang pi)(+ ang pi))
((> ang pi)(- ang pi))
((equal ang pi) 0.0)
((equal ang 0.0) pi)
)
)
;; ================= body of main function starts here ======================
;; ----------- Get the Text to Align -----------------
(cond
((setq txt_ent (car (entsel "\nSelect text to align")))
(setq txt_obj (vlax-ename->vla-object txt_ent)
obj_typ (vlax-get-property txt_obj 'ObjectName)
)
(cond
((or (= obj_typ "AcDbMText") (= obj_typ "AcDbText")))
(T
(setq txt_ent nil)
(alert "I only know how to align (M)TEXT, sorry! "))
)
)
)
;; ----------- Get the Object to Align To -----------------
(cond
((and txt_ent
(setq ent (entsel "\nSelect entity for alignment: ")))
(setq obj (vlax-ename->vla-object (car ent))
obj_typ (vlax-get-property obj 'ObjectName)
)
(cond
((= obj_typ "AcDbPolyline")
(if (setq pt_lst (getSegment obj (last ent)))
(setq ang (angle (cadr pt_lst)(caddr pt_lst)))
)
)
((= obj_typ "AcDbLine")
(setq ang (vlax-get-property obj 'Angle))
)
((= obj_typ "AcDbText")
(setq ang (vlax-get-property obj 'Rotation))
)
((= obj_typ "AcDbMText")
(setq ang (vlax-get-property obj 'Rotation))
)
((= obj_typ "AcDbArc")
(setq ang (angle
(vlax-safearray->list
(vlax-variant-value
(vla-get-StartPoint obj)))
(vlax-safearray->list
(vlax-variant-value
(vla-get-EndPoint obj)))
)
)
)
(T (alert "That's not an entity I deal with"))
)
)
)
;; ----------- Align the Text -----------------
(cond
((null ang)) ; do nothing
((null txt_ent)) ; do nothing
(T
(undobegin)
(vlax-put-property txt_obj 'Rotation ang)
(setq ans (getstring "\nRotate 180 [Y/N]<N>: "))
(if (= (strcase ans) "Y")
(vlax-put-property txt_obj 'Rotation (get-opp-ang ang))
)
(vlax-release-object txt_obj)
(undoend)
)
)
(princ)
)
