Mark Thomas
7th Dec 2004, 05:40 pm
Just posted this on theswamp and thought I'd share with good people here at the CADTutor Forum
(defun c:rrt (/
; local functions
getSegment get-opp-ang undobegin undoend
; local variables
ent 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
;;;
;;; 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 ======================
(cond ((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))
)
(T (alert "That's not an entity I deal with"))
)
)
)
(if ang
(cond ((setq ent (car (entsel "\nSelect text to align")))
(setq obj (vlax-ename->vla-object ent)
obj_typ (vlax-get-property obj 'ObjectName)
)
(cond
((or (= obj_typ "AcDbMText") (= obj_typ "AcDbText"))
(undobegin)
(vlax-put-property obj 'Rotation ang)
(setq ans (getstring "\nRotate 180 [Y/N]<N>: "))
(if (= (strcase ans) "Y")
(vlax-put-property obj 'Rotation (get-opp-ang ang))
)
(vlax-release-object obj)
(undoend)
)
(T (alert "I only know how to align (M)TEXT, sorry! "))
)
)
)
)
(princ)
)
(defun c:rrt (/
; local functions
getSegment get-opp-ang undobegin undoend
; local variables
ent 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
;;;
;;; 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 ======================
(cond ((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))
)
(T (alert "That's not an entity I deal with"))
)
)
)
(if ang
(cond ((setq ent (car (entsel "\nSelect text to align")))
(setq obj (vlax-ename->vla-object ent)
obj_typ (vlax-get-property obj 'ObjectName)
)
(cond
((or (= obj_typ "AcDbMText") (= obj_typ "AcDbText"))
(undobegin)
(vlax-put-property obj 'Rotation ang)
(setq ans (getstring "\nRotate 180 [Y/N]<N>: "))
(if (= (strcase ans) "Y")
(vlax-put-property obj 'Rotation (get-opp-ang ang))
)
(vlax-release-object obj)
(undoend)
)
(T (alert "I only know how to align (M)TEXT, sorry! "))
)
)
)
)
(princ)
)