Author Topic: Align Text Routine  (Read 21267 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Align Text Routine
« on: November 11, 2008, 09:05:30 PM »
I have been messing about with this routine. It's a little different than most Text Align Routines in that
it does not change the justification of the text object & it works with mixed text & mtext.

I thought I would post this "Work In Progress" to see if anyone wants to add there code and / or
comments to the routine. As you can see I'm just getting started but have run out of gas.

So if you're interested jump right in. Comments welcome.

<UPDATED TO Version 1.1>

Code: [Select]
;;  CAB 11.12.08  Version 1.1
;;
;;  Align a group of text or mtext objects along there X or Y axis
;;  User picks Master text & then text to align under it
;;  Does not change the text alignment or justification or combine text
;;  Uses the justification of the Master text to set alignment
;;  This routine simply moves & rotates the text
;;  Will allow Master text on any angle
;;
;;  -----   N O T E S  ------
;;  only supports vertical alignment at this time, will add Horizontal
;;  you must select text in order top to bottom, need to allow sorting
;;    on the x or y axis, see note on line 47
;;  No support for UCS at this time
;;

(defun c:at() (c:TextAlign)) ; shortcut

(defun c:TextAlign (/ t1 xy ent elist ss lst cor dir bang gap npt ename clst i obj
                    atpm atp$ ppt
                    atp_decode_mText atp_decode_Text
                    )
  (vl-load-com)

  (defun atp_decode_mText (code)
    (cond
      ((vl-position code '(1 4 7)) "Left")
      ((vl-position code '(2 5 8)) "Center")
      ((vl-position code '(3 6 9)) "Right")
    )
  )

  (defun atp_decode_Text (code)
    ;;  3 - acAlignmentAligned
    ;;  5 - acAlignmentFit
    (cond
      ((vl-position code '(0 6 9 12)) "Left")
      ((vl-position code '(1 4 7 10 13 3 5)) "Center")
      ((vl-position code '(2 8 11 14)) "Right")
    )
  )


  ;;============================
  ;;      S T A R T   H E R E   
  ;;============================
  (setvar "errno" 0)
  (setq xy "X")
  (while
    (progn
      (initget "V H")
      (setq
        t1 (entsel
             "\nSelect master text to align Verticaly or <\"H\"> to align Horrizontally:  "
           ))
        (cond
          ((null t1) (setq xy "X"))
          ((= t1 "H") (setq xy "Y"))
          ((listp t1)
           (setq ent (car t1)
                 elist (entget ent))
           (if (not (member (cdr (assoc 0 elist)) '("TEXT" "MTEXT")))
             (princ "\nError - must be a text object.")
           )
          )
          (t (princ "\nMissed, Try again."))
        )
      )
  ) ; end while

  ;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ;;  Note that ssget will order the selections within the selection set only
  ;;  when the picks are one at at time.  Therefore any sorting based on X,Y
  ;;  coordinates might want to give priority to those items selected first
  ;;  If the (caar value is 1 then it is a PICK else window or other sel method
  ;;
  ;;  At this time only the selection set order is being used: version 1.0
  (prompt "\nSelect Text to align with Master Text.")
  (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
    (progn
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
      (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq lst (vl-remove ent lst)) ; remove master if it was selected again
      ;;  got a master text object
      (cond
        ((= (cdr (assoc 0 elist)) "TEXT")
         (setq cor (get_box_dtext ent)) ; get the corners '(ll lr ur ul)
         (setq atpm (atp_decode_Text (vla-get-Alignment (vlax-ename->vla-object ent))))
         )
        (t ; mText
         (setq cor (get_box_mtext ent)) ; get the corners '(ll lr ur ul)
         (setq atpm (atp_decode_mText (vla-get-AttachmentPoint (vlax-ename->vla-object ent))))
         )
      )
     
      (setq dir (angle (last cor) (car cor)) ; offset direction
            bang (angle (car cor)(cadr cor)) ; Base angle
            gap  (* (cdr(assoc 40 elist)) 0.6666) ; text height of master text
      )
      ;;  correct for near zero angle
      (if (equal dir (* 2 pi) 0.0001) (setq dir 0.0))
      (if (equal bang (* 2 pi) 0.0001) (setq bang 0.0))

      (cond ; get next point
        ((= atpm "Left")   (setq npt (polar (car cor) dir gap)))
        ((= atpm "Center") (setq npt (polar (polar (car cor) bang
                                                   (/ (distance (car cor)(cadr cor)) 2.)) dir gap)))
        ((= atpm "Right")  (setq npt (polar (cadr cor) dir gap)))
      )
      (setq i -1)
      (while (setq ename (ssname ss (setq i (1+ i))))
        (setq obj (vlax-ename->vla-object ename))
        (cond
          ((= (cdr (assoc 0 (entget ename))) "TEXT")
           (setq clst (get_box_dtext ename)) ; get the corners '(ll lr ur ul)
           ;(setq atp$ (atp_decode_Text (vla-get-Alignment obj)))
           )
          (t ; mText
           (setq clst (get_box_mtext ename)) ; get the corners '(ll lr ur ul)
           ;(setq atp$ (atp_decode_mText (vla-get-AttachmentPoint obj)))
           )
        )
        (cond ; get base point for MOVE [TL TC TR]
          ((= atpm "Left")   (setq ppt (vlax-3d-point(last clst))))
          ((= atpm "Center")
           (setq ppt (vlax-3d-point(polar (last clst) bang (/ (distance (car clst)(cadr clst)) 2.)))))
          ((= atpm "Right")  (setq ppt (vlax-3d-point(caddr clst))))
        )
       
        ;(command "rectang" "non" (car clst) "non" (caddr clst)) ; debug
        ;;  Move the text into place & rotate if needed
        (vla-move obj ppt (vlax-3d-point npt)) ; WCS
        (if (not(equal bang (vla-get-rotation obj) 0.0001))
          (vla-rotate obj (vlax-3d-point npt) (- bang (vla-get-rotation obj)))
        )
        ;;  advance the point for top left of next text ent
        (setq npt (polar npt dir (+ gap (distance (car clst)(last clst)))))
        ;(setq clst (get_box_dtext ename)) ; debug
        ;(command "rectang" "non" (car clst) "non" (caddr clst)) ; debug
      )
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    ) ; progn
  ) ; endif
  ;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 
  (princ)
)






;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;       +              get_box_mtext                             +
;;;       +            Created by C. Alan Butler                   +
;;;       +               Copyright 2005                           +
;;;       +   by Precision Drafting & Design All Rights Reserved.  +
;;;       +    Contact at ab2draft@TampaBay.rr.com                 +
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;
;;; VERSION
;;;  1.2 Jan 24, 2006  UCS corrections
;;;
;;; FUNCTION
;;;  Return Box coordinates for an Mtext object in any UCS, any angle.
;;;
;;; USAGE
;;;  (box_mtext ent)
;;;
;;; ARGUMENTS
;;;  ent = mtext ename
;;;
;;;  RETURNS
;;;   list of 4 points for box,  (ll lr ur ul)
;;;
;;; PLATFORMS
;;;  2000+ Tested in 2000 only
(defun get_box_mtext (ent / elst p10 txth ang vec wid hgt dxf UCSangle
                  attpt ul ur lr ll)
  (defun dxf (code elst)
    (cdr (assoc code elst))
  )

  ;; incase it is a list,  (ename point)
  (and (listp ent) (setq ent (car ent)))
  (setq elst (entget ent))

  (setq p10   (trans (dxf 10 elst) 0 1) ; insertion point WCS to UCS
        txth  (dxf 40 elst) ; text height
        wid   (dxf 42 elst) ; full width
        hgt   (dxf 43 elst) ; full height
        ang   (dxf 50 elst) ; rotation angle in UCS
        attpt (dxf 71 elst) ; attachment point code
  )

  ;|--------------------------------------------------------------
  ;;  CAB 01/24/2006 removed as the ang fron DXF code 50 os in UCS
  ;;  correct for UCS
  (setq  ang (- ang (angle (trans '(0.0 0.0 0.0) 1 0)
                           (trans '(1.0 0.0 0.0) 1 0)))
  )
  ;;  angles  90 = (/ pi 2)   180 = pi  270 = (* pi 1.5)
  ---------------------------------------------------------------|;

 
  ;;  Get upper left (ul) from insert point (p10)
  (cond ((= attpt 1) (setq ul p10)) ; top left
        ((= attpt 2) (setq ul (polar p10 (+ pi ang) (/ wid 2)))) ; top center
        ((= attpt 3) (setq ul(polar p10 (+ pi ang) wid))) ; top right
        ((= attpt 4) (setq ul (polar p10 (+ (/ pi 2) ang) (/ hgt 2)))) ; middle left
        ((= attpt 5) ; middle center
         (setq ul (polar (polar p10 (+ pi ang) (/ wid 2)) (+ (/ pi 2) ang) (+ (/ hgt 2)))))
        ((= attpt 6) ; middle right
         (setq ul (polar (polar p10 (+ pi ang) wid) (+ (/ pi 2) ang) (+ (/ hgt 2)))))
        ((= attpt 7) (setq ul (polar p10 (+(/ pi 2) ang) hgt))) ; bottom left
        ((= attpt 8) ; bottom center
         (setq ul (polar (polar p10 (+ pi ang) (/ wid 2)) (+ (/ pi 2) ang) hgt)))
        ((= attpt 9) ; bottom right
         (setq ul (polar (polar p10 (+ pi ang) wid) (+ (/ pi 2) ang) hgt)))
  );cond
  (setq ur (polar ul ang wid)
        lr (polar ur (+ ang (* pi 1.5)) hgt)
        ll (polar lr (+ ang pi) wid)
  );setq
  (list ll lr ur ul)
);boxmtext



;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;       +                   box_text                             +
;;;       +            Created by C. Alan Butler                   +
;;;       +               Copyright 2005                           +
;;;       +   by Precision Drafting & Design All Rights Reserved.  +
;;;       +    Contact at ab2draft@TampaBay.rr.com                 +
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;
;;; VERSION
;;;  1.2 Jan 24, 2006  UCS corrections
;;;
;;; FUNCTION
;;;  Return Box coordinates for an dtext object in any UCS, any angle.
;;;
;;; USAGE
;;;  (box_text ent)
;;;
;;; ARGUMENTS
;;;  ent = text ename
;;;
;;;  RETURNS
;;;   list of 4 points for box,  (ll lr ur ul)
;;;
;;; PLATFORMS
;;;  2000+ Tested in 2000 only
;;; FUNCTION
(defun get_box_dtext (ent / i ename elist lst lst2 tb tb1 tb2 tlen thi ll lr
                  ur ul ang angg UCSang llx lrx urx ulx lly lry ury uly all
                   avg err cntlst
                 )

  (setq UCSang (angle (trans '(0.0 0.0 0.0) 1 0)
                      (trans '(1.0 0.0 0.0) 1 0)
               )
  )
 
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  ;;      get the bounding box   
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
    (setq elist (entget ent)
          ang   (cdr (assoc 50 elist)) ; text angle
          tb    (textbox elist) ; Note thst I had some problems with this
          ;tb    (textbox (list (assoc 1 elist) (assoc 40 elist)(assoc 7 elist)));(textbox (list (assoc 1 elist))) ; CAB 11.11.08
          tb1   (car tb)  ; Lower Left Relative to text
          tb2   (cadr tb) ; Upper Right relative to text
          tlen  (- (car tb2) (car tb1))
          thi   (- (cadr tb2) (cadr tb1))
          ;;  new ll  CAB 01/24/06
          ll    (MapCar '+ (trans (cdr (assoc 10 elist)) 0 1) tb1)
         
          ang   (- ang UCSang) ; correct for UCS
          lr    (polar ll ang tlen)
          ur    (polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2))
          ul    (polar ll (+ ang (/ pi 2)) thi)
    ) ;setq
  ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-

    (list ll lr ur ul)
) ; end defun box_dtext
;;; x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x-x
« Last Edit: November 12, 2008, 10:13:07 AM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Align Text Routine
« Reply #1 on: November 11, 2008, 11:24:02 PM »
PS Tim's fine routine got me kicking this one around. Just another way to Skin the Cat.  8-)
http://www.theswamp.org/index.php?topic=9290.msg119681#msg119681
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Align Text Routine
« Reply #2 on: November 12, 2008, 12:52:59 AM »
PS Tim's fine routine got me kicking this one around. Just another way to Skin the Cat.  8-)
http://www.theswamp.org/index.php?topic=9290.msg119681#msg119681

I have even updated that one to use the routine gile and myself did to select attributes.  Here [ http://www.theswamp.org/index.php?topic=19886.0 ].

I will try your code tomorrow Alan.  I should have time.

Code: [Select]
(defun c:lu(/ ActDoc Sel AliOpt AliPt MasterObj ObjList tempPt tempEnt)
    ; Lines up text, attribute definitions and attribute references.
   
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (if
        (and
            (or
                (initget "X Y")
                (if (setq Sel (nentsel "\n Select master text to align along X axis or <\"Y\"> to align along Y axis: "))
                    (cond
                        ((listp Sel)
                            (setq AliOpt "X")
                            (vl-position
                                (vla-get-ObjectName
                                    (setq MasterObj (vlax-ename->vla-object (setq tempEnt (car Sel))))
                                )
                                '("AcDbText" "AcDbAttributeDefinition" "AcDbAttribute")
                            )
                        )
                        ((= Sel "Y")
                            (setq AliOpt "Y")
                            (if (setq Sel (nentsel "\n Select master text to align along the Y axis: "))
                                (vl-position
                                    (vla-get-ObjectName
                                        (setq MasterObj (vlax-ename->vla-object (setq tempEnt (car Sel))))
                                    )
                                    '("AcDbText" "AcDbAttributeDefinition" "AcDbAttribute")
                                )
                            )
                        )
                    )
                )
            )
            (setq AliPt
                (trans
                    (if (equal (vla-get-Alignment MasterObj) 0)
                        (vlax-get MasterObj 'InsertionPoint)
                        (vlax-get MasterObj 'TextAlignmentPoint)
                    )
                    0
                    1
                )
            )
            (not (redraw tempEnt 3))
            (setq ObjList (SelAtts "Select attributes/text entities to line up: " T))
        )
        (foreach obj ObjList
            (setq tempPt
                (if (equal (vla-get-Alignment obj) 0)
                    (vlax-get obj 'InsertionPoint)
                    (vlax-get obj 'TextAlignmentPoint)
                )
            )
            (vlax-put
                obj
                (if (equal (vla-get-Alignment obj) 0)
                    'InsertionPoint
                    'TextAlignmentPoint
                )
                (trans
                    (list
                        (if (= AliOpt "X")
                            (car AliPt)
                            (car tempPt)
                        )
                        (if (= AliOpt "Y")
                            (cadr AliPt)
                            (cadr tempPt)
                        )
                        (caddr tempPt)
                    )
                    1
                    0
                )
            )
        )
    )
    (if tempEnt (redraw tempEnt 4))
    (vla-EndUndoMark ActDoc)
    (princ)
)

I think the only sub is the 'SelAtts' sub, and here is the one from my files ( as it might have been updated ).

Code: [Select]
(defun SelAtts (Message bAllowText / Sel EntData Pt1 Pt3 gr p1 p2 p3 p4 po ss SelMode SelObjList flag)
; updated by gile @theSwamp.org to show the selection correctly.
; updated by T.Willey to allow the option to select text objects, not mtext
; updated by T.Willey, added new sub to see if the selection box and the bounding box of the objects
;    selected cross, so that a true crossing is simulated

(defun DoBoxesCross (PtList1 PtList2 / Intersect cnt cnt2)

(setq cnt 0)
(while
(and
(not Intersect)
(< cnt 4)
)
(setq cnt2 0)
(repeat 4
(if
(inters
(nth cnt PtList1)
(nth
(if (equal cnt 3)
0
(1+ cnt)
)
PtList1
)
(nth cnt2 PtList2)
(nth
(if (equal cnt2 3)
0
(1+ cnt2)
)
PtList2
)
T
)
(setq Intersect T)
)
(setq cnt2 (1+ cnt2))
)
(setq cnt (1+ cnt))
)
Intersect
)
;----------------------------------------------------------------------------------------------------
(defun GetAttSelection (ss SelMode / ObjList PtList TestList ll ur tempPtList SelObjList)

(foreach lst (ssnamex ss)
(cond
((equal (car lst) 3)
(setq ObjList (cons (vlax-ename->vla-object (cadr lst)) ObjList))
)
((equal (car lst) -1)
(foreach sub-lst (cdr lst)
(setq PtList (cons (cadr sub-lst) PtList))
)
)
)
)
(foreach obj ObjList
(cond
((= (vla-get-ObjectName obj) "AcDbBlockReference")
(foreach att (vlax-invoke obj 'GetAttributes)
(if
(and
(/= (vla-get-TextString att) "")
(= (vla-get-Invisible att) :vlax-false)
)
(progn
(setq TestList nil)
(vla-GetBoundingBox att 'll 'ur)
(setq tempPtList
(list
(setq ll (safearray-value ll))
(setq ur (safearray-value ur))
(list (car ur) (cadr ll) (caddr ll))
(list (car ll) (cadr ur) (caddr ll))
)
)
(foreach pt tempPtList
(if
(and
(< (caar PtList) (car pt) (caadr PtList))
(< (cadar PtList) (cadr pt) (cadr (caddr PtList)))
)
(setq TestList (cons T TestList))
)
)
(if (= SelMode "Windowing")
(if (equal (length TestList) 4)
(setq SelObjList (cons att SelObjList))
)
(if
(or
TestList
(DoBoxesCross PtList tempPtList)
)
(setq SelObjList (cons att SelObjList))
)
)
)
)
)
)
(
(or
(= (vla-get-ObjectName obj) "AcDbText")
(= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
)
(if
(or
(/= (vla-get-TextString obj) "")
(and
(vlax-property-available-p obj 'TagString)
(/= (vla-get-TagString obj) "")
)
)
(progn
(setq TestList nil)
(vla-GetBoundingBox obj 'll 'ur)
(setq tempPtList
(list
(setq ll (safearray-value ll))
(setq ur (safearray-value ur))
(list (car ur) (cadr ll) (caddr ll))
(list (car ll) (cadr ur) (caddr ll))
)
)
(foreach pt tempPtList
(if
(and
(< (caar PtList) (car pt) (caadr PtList))
(< (cadar PtList) (cadr pt) (cadr (caddr PtList)))
)
(setq TestList (cons T TestList))
)
)
(if (= SelMode "Windowing")
(if (equal (length TestList) 4)
(setq SelObjList (cons obj SelObjList))
)
(if
(or
TestList
(DoBoxesCross PtList tempPtList)
)
(setq SelObjList (cons obj SelObjList))
)
)
)
)
)
)
)
SelObjList
)
;----------------------------------------------------------------------------------------------------
(defun gr-sel (/ loop gr pt)

(setq loop T)
(while (and (setq gr (grread T 12 2)) (/= (car gr) 3) loop)
(cond
((= (car gr) 5)
(setq pt (cadr gr))
)
(
(or
(member gr '((2 13) (2 32)))
(or (= (car gr) 11) (= (car gr) 25))
)
(setq loop nil
pt   nil
)
)
)
)
(if pt
(cond
((car (nentselp pt)))
(pt)
)
)
)
;---------------------------------------------------------------------------------------------------------
(setvar "ErrNo" 0)
(while
(and
(princ (strcat "\n" Message))
(setq sel (gr-sel))
)
(if (listp sel)
(progn
(setq p1  (list (car sel) (cadr sel))
pt1 (trans p1 1 2)
)
(princ "\nSpecify the opposite corner: ")
(while (and (setq gr (grread T 12 1)) (/= (car gr) 3))
(if (= 5 (car gr))
(progn
(redraw)
(setq pt3 (trans (cadr gr) 1 2)
p2 (trans (list (car pt3) (cadr pt1)) 2 1)
p3 (list (caadr gr) (cadadr gr))
p4 (trans (list (car pt1) (cadr pt3)) 2 1)
)
(if (< (car pt1) (car (trans p2 1 2)))
(progn
(setq SelMode "Windowing")
(grvecs (list 255 p1 p2 255 p2 p3 255 p3 p4 255 p4 p1))
)
(progn
(setq SelMode "Crossing")
(grvecs
(list -255 p1 p2 -255 p2 p3 -255 p3 p4 -255 p4 p1)
)
)
)
)
)
)
(redraw)
(if
(if bAllowText
(setq ss (ssget "_C" p1 p3 '((0 . "INSERT,TEXT,ATTDEF"))))
(setq ss (ssget "_C" p1 p3 '((0 . "INSERT"))))
)
(setq SelObjList (append SelObjList (GetAttSelection ss SelMode)))
)
)
(progn
(setq EntData (entget Sel))
(if
(or
(= (cdr (assoc 0 EntData)) "ATTRIB")
(and
bAllowText
(vl-position (cdr (assoc 0 EntData)) '("TEXT" "ATTDEF"))
)
)
(progn
(setq SelObjList
(cons (vlax-ename->vla-object Sel) SelObjList)
)
(redraw Sel 3)
)
)
)
)
(foreach att SelObjList
(redraw (vlax-vla-object->ename att) 3)
)
)
(foreach att SelObjList
(redraw (vlax-vla-object->ename att) 4)
)
SelObjList
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: Align Text Routine
« Reply #3 on: November 12, 2008, 03:36:55 AM »

:)
Thank goodness for the Mercury theme with the big code pane :)
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Align Text Routine
« Reply #4 on: November 12, 2008, 10:14:10 AM »
Update code to version 1.1
Code will now do Left, Center, & Right Justification based on the Master text justification.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

jvillarreal

  • Bull Frog
  • Posts: 332
Re: Align Text Routine
« Reply #5 on: November 13, 2008, 03:43:26 PM »
First post here...
Nice work Alan :-o You and all the other gurus here do amazing work.
I have to ask though, why not use the existing txt2mtxt express tool?

Code: [Select]
(defun c:tm (/ pt1 pt2 selset n)
(vl-load-com)
(setq pt1 (getpoint "\nSelect First Point: "))
(setq pt2 (getcorner pt1 "\nSelect Opposite Corner: "))
(setq selset (ssget "_C" pt1 pt2 '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(-4 . "OR>"))))
(setq n 0)
(repeat (sslength selset)
(if (/= (cdr (assoc 0 (entget (ssname selset n)))) "TEXT")
(vl-cmdf "explode" (ssname selset n))
);if
(setq n (1+ n))
);repeat
(setq selset (ssget "_C" pt1 pt2 '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(-4 . "OR>"))))
(vl-cmdf "txt2mtxt" selset "")
(princ)
);defun

jvillarreal

  • Bull Frog
  • Posts: 332
Re: Align Text Routine
« Reply #6 on: November 13, 2008, 04:23:25 PM »
"create word-wrap Mtext" should be unchecked in the txt2mtxt options to make it work more similarly..and it doesn't keep the original justification of the text being aligned..

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Align Text Routine
« Reply #7 on: November 13, 2008, 04:41:11 PM »
Alan,

  I got around to testing this today, and it flipped the order of the text when used.  Attached is a pic that will show what I'm talking about.  The left is the before, with the right being after.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Align Text Routine
« Reply #8 on: November 13, 2008, 04:45:46 PM »
I noticed that it also move them vertically.  Is the routine going to be used to line up and move the text so it looks like a group of notes?  If so I have one like that also.  Let me know.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Align Text Routine
« Reply #9 on: November 13, 2008, 05:35:46 PM »
jvillarreal,
Welcome to The Swamp.

I could use express tool or use the routine Tim is referring to.

This is an exercise. I often create routines just for fun & never use them. Call me crazy
but I just like to create code. :roll:
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Align Text Routine
« Reply #10 on: November 13, 2008, 05:38:26 PM »
This is an exercise. I often create routines just for fun & never use them. Call me crazy
but I just like to create code. :roll:
x2

Sometimes I see something that sounds fun, so I just see if I can tackle it.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Align Text Routine
« Reply #11 on: November 13, 2008, 05:57:01 PM »
Tim,
There is no sorting of the selection set so you must pick the text individually and in order.
I will get to the sort part eventually. The text objects will remain as found. The spacing
is from the Master text object.
gap  (* (cdr(assoc 40 elist)) 0.6666) ; text height of master text

Oops i see the bug in my second example below. That's curious!
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Notsober

  • Guest
Re: Align Text Routine
« Reply #12 on: November 25, 2008, 08:57:20 AM »
hey CAB. When I saw this, I thought, Man I could use this!

but when I tested it, the first problem arises when i execute the command.

It gives me this: "Your pointing device cannot be used as a tablet."



I'm using just a regular ole dell two clicker scroll mouse.... and no tablets. I don't even know what a tablet is or for.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Align Text Routine
« Reply #13 on: November 25, 2008, 09:30:37 AM »
Sorry you had a problem. The routine is a work in progress and not ready for prime time.  8-)

This is a tablet: http://www.logicgroup.com/Tablets/DB3.htm
but should have nothing to do with this routine.

I should have an update posted today so check back.


I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Notsober

  • Guest
Re: Align Text Routine
« Reply #14 on: November 25, 2008, 09:49:45 AM »
i'll definitely check back.

crap.

I was typing TA instead of AT.

 :ugly:
« Last Edit: November 25, 2008, 09:55:00 AM by Notsober »