Topic: Text Rotate Lisp (Mark Thomas)

[DanB]

I have been happily using the following code that Mark had posted in another thread. I was curious if anyone was able to update it to handle arcs as well? Currently, I edit the arc to pline then explode it after aligning the text.

Thanks in advance for any assistance, the lisp is very helpful.

Dan

Code: [Select]


(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)
  )


[Crank]

I like the alignment of text to segments of polylines, but I find it confusing that you have to pick the other object first. You would expect to pick the text first and then the object to align to.
(A selectionset with (M)texts to align would even be better. )

To answer your question:
You can add:

Code: [Select]


((= obj_typ "AcDbArc") ; This is an arc
   [insert your code here]
)

It takes some maths to get the angle:
 (cdr (assoc 50 (entget (car ent)))); = center point
 (cdr (assoc 50 (entget (car ent)))); = start angle
 (cdr (assoc 51 (entget (car ent)))); = end angle
You now can find the endpoints of the arc and the angle between those points.

So perhaps it's easier to use your methode: make a polyline of the arc and explode it after you get the angle.

[CAB]

Would this be what you are looking for?
Added the 'ARC' object.

Code: [Select]

(defun c:rrt (/
               ; local functions
               getSegment get-opp-ang undobegin undoend ptstart ptend
               ; 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
  ;;; 1.1 Tue Dec 21, 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))
                )
               ((= obj_typ "AcDbArc")
                (setq ptend (vlax-safearray->list
                              (vlax-variant-value
                                (vla-get-EndPoint obj)))
                      ptstart (vlax-safearray->list
                                (vlax-variant-value
                                  (vla-get-StartPoint obj)))
                      ang (angle ptstart ptend))
                )
               
               (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)
  )

[CAB]

Crank
Here is the reverse pick order. Text first.

Code: [Select]

(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)
)

[daron]

BTW, I believe the math you speak of is taken care of through the properties in the activeX programming. Have a look at what vlax-dump-object spills on an arc object.

[DanB]

Many thanks to all, this works even better now!

Dan

[CAB]

Thanks to Mark, He did all the work.  
I just added a few extra lines of code.

[CAB]

As far as the math goes.
The chord angle is not give but with the start and end points all you need is (angle start end)

Code: [Select]


(setq cen (cdr (assoc 10 ed)) ;center
      rad (cdr (assoc 40 ed)) ;radius
      sta (cdr (assoc 50 (entget (car ent)))); = start angle
      end (cdr (assoc 51 (entget (car ent)))); = end angle
      p1  (polar cen sta rad) ;start point
      p2  (polar cen end rad) ;end point
      ang (angle p1 p2)
)
or in vlisp

Code: [Select]

(setq ang (angle
             (vlax-safearray->list
                (vlax-variant-value
                    (vla-get-StartPoint obj)))
             (vlax-safearray->list
                 (vlax-variant-value
                   (vla-get-EndPoint obj)))
)

[t-bear]

I have a question ... is this supposed to "wrap" the given line(s) of text along the curve of an arc or just align it along the chord of the arc?  What I was thinking it did was something along the lines of the arctext command......
Just curious.

[CAB]

Arc Text is a different animal. This routine uses the Arc Chord Angle.
Arc Text is special object created by Express Tools. There are so many options it may be better
left to ET to create it. That said I think you could create it given a standard set of defaults.
Never looked into it.

[MSTG007]

question... would this work with xrefs?

[mohan]

Hello CAB

Need a lisp that will rotate text to the nearest polyline perpendicular

thanks