Author Topic: Align Text Routine  (Read 15191 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
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: 10395
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: 5247
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 :)
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
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: 327
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: 327
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: 5247
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: 5247
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: 10395
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: 5247
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: 10395
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: 10395
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 »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #15 on: November 25, 2008, 10:08:21 AM »
That would do it.  :roll:

Try this version attached. It should correct the CENTER justification error Tim pointed out.

<edit: removed old code>

« Last Edit: November 26, 2008, 05:29:10 PM 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.

Spike Wilbury

  • Guest
Re: Align Text Routine
« Reply #16 on: November 25, 2008, 10:31:51 AM »
now that I don't write lisp, it feels good to grab routines like this one :)

the only thing I do not like and never use it on my lisps was the use of cancel to stop a command, among the other stuff, it looks good.... (just a last one if I may... why does not leave the texts on their location(s) rows, instead of grouping them - OK was a quick test, uff to much wording, sorry)

Notsober

  • Guest
Re: Align Text Routine
« Reply #17 on: November 25, 2008, 10:35:52 AM »
it messes up my horizontal spacing.

Code: [Select]
Command: at
Select master text to align Verticaly or <"H"> to align Horrizontally:

I want to align Vertically only.


CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #18 on: November 25, 2008, 10:48:54 AM »
Can you post a sample DWG so I can see your request / problem?

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: 10395
Re: Align Text Routine
« Reply #19 on: November 25, 2008, 10:49:51 AM »
Thanks Luis.
I was setting up for the user exit but never got to that. Added it to this revised 1.2 version.
See post above.
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.

Spike Wilbury

  • Guest
Re: Align Text Routine
« Reply #20 on: November 25, 2008, 11:00:00 AM »
Thanks Luis.
I was setting up for the user exit but never got to that. Added it to this revised 1.2 version.
See post above.

Downloaded....

Alan,

It is the idea of doing the alignment in my case vertical - to place the selected text(s) below the master text (per the prompt) ?

It does not preserve the same row location?

Thanks.

Notsober

  • Guest
Re: Align Text Routine
« Reply #21 on: November 25, 2008, 11:09:22 AM »
Thanks Luis.
I was setting up for the user exit but never got to that. Added it to this revised 1.2 version.
See post above.

Downloaded....

Alan,

It is the idea of doing the alignment in my case vertical - to place the selected text(s) below the master text (per the prompt) ?

It does not preserve the same row location?

Thanks.

this is what I'm talking about...

I have a certain spacing between the individual notes... when I select master text, then all text to be aligned with master, it moves not only in the horizontal, but also vertically, thus trashing the spacing between the notes.
« Last Edit: November 25, 2008, 11:15:48 AM by Notsober »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #22 on: November 25, 2008, 11:16:35 AM »
The Master text spacing is used to set the vertical spacing of the remaining text objects.
Code: [Select]
gap  (* (cdr(assoc 40 elist)) 0.6666) ; text height of master textIf there are mtext objects selected it will not alter the spacing within the mtext.

The alignment is also based on the Master Text Object. If it is Right justified then the remaining text
will be moved to the right side but the actual alignment style of the remaining text will not be changed.

Note that the Horizontal option in the first prompt is not functional at this time.

Having said all that I get the feeling I'm missing your point as to what is not functioning properly.  :-(
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.

Spike Wilbury

  • Guest
Re: Align Text Routine
« Reply #23 on: November 25, 2008, 11:19:27 AM »
Thanks Luis.
I was setting up for the user exit but never got to that. Added it to this revised 1.2 version.
See post above.

Downloaded....

Alan,

It is the idea of doing the alignment in my case vertical - to place the selected text(s) below the master text (per the prompt) ?

It does not preserve the same row location?

Thanks.

this is what I'm talking about...

I have a certain spacing between the individual notes... when I select master text, then all text to be aligned with master, it moves not only in the horizontal, but also vertically, thus trashing the spacing between the notes.

I see.... next time I need to read the description on Alan's routine:

Quote
Align a group of text or mtext objects along there X or Y axis
User picks Master text & then text to align under it <<<<----------------

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #24 on: November 25, 2008, 11:33:16 AM »
Notsober,
You did not include a BEFORE example so i can't tell.
But you want to set your own vertical spacing or to ignore vertical spacing?

As you can see from my examples I had envisioned the routine cleaning up a very messy DWG.
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 #25 on: November 25, 2008, 11:33:33 AM »

I see.... next time I need to read the description on Alan's routine:

Quote
Align a group of text or mtext objects along there X or Y axis
User picks Master text & then text to align under it <<<<----------------

haha... align right under it

Notsober

  • Guest
Re: Align Text Routine
« Reply #26 on: November 25, 2008, 11:34:35 AM »
Notsober,
You did not include a BEFORE example so i can't tell.

i certainly did here

Quote
But you want to set your own vertical spacing or to ignore vertical spacing?

both would be nice ;)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #27 on: November 25, 2008, 11:40:34 AM »
I had trouble with the pictures, could not find the item number.
This is my test.
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 #28 on: November 25, 2008, 11:47:18 AM »
I had trouble with the pictures, could not find the item number.
This is my test.


see how it changed my vertical spacing?

that would be an undesirable outcome for me... I work hard to get all that text spaced just right!  :-P

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #29 on: November 25, 2008, 11:53:48 AM »
In the test DWG you posted the text looked fine.
Please post a DWG with the wrong result.
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 #30 on: November 25, 2008, 11:59:32 AM »
here's before and after dwg's


CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #31 on: November 25, 2008, 12:08:56 PM »
OK, it appears as though you want 2-1/8" vertical spacing between the mtext objects.

I was thinking about a prompt for spacing, "Auto" "Fixed" "None"
Auto would be the formula I am using now.
Fixed would be a User entered distance.
None would be to use the existing vertical spacing.

Would that resolve the issue?
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 #32 on: November 25, 2008, 12:16:46 PM »
OK, it appears as though you want 2-1/8" vertical spacing between the mtext objects.

I was thinking about a prompt for spacing, "Auto" "Fixed" "None"
Auto would be the formula I am using now.
Fixed would be a User entered distance.
None would be to use the existing vertical spacing.

Would that resolve the issue?


PERFECT option!

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #33 on: November 26, 2008, 05:35:38 PM »
Here is another version. I think the Spacing option is working correctly.
The routine always starts in the Auto Mode.
There is Help screen.
The Horizontal is not operational.

« Last Edit: November 26, 2008, 06:12:18 PM 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.

Pad

  • Bull Frog
  • Posts: 324
Re: Align Text Routine
« Reply #34 on: June 30, 2009, 08:32:29 AM »
Hi CAB

hope you don't mind me resurrecting this old post?
I use your text align group (in particular AT command) a lot.
I have a small problem.
The attached dwg, will hopefully clarify things.
The text is all centre justified, after running 'AT' the justified text moves slightly off.
autocad 2004, CAB013

Thanks
Pad

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #35 on: June 30, 2009, 09:41:40 AM »
Thanks for the input.

Enter this at the command line
Code: [Select]
(setq atdebut t)Then run you test again.
You will see that the "Text Box" used to create the alignment is correct.
The problem is that the "Center Justification" for the word SURVEY does not agree exactly with the
text box created. Because my routine uses the Text Box & not the alignment point there can be
small variations.
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.

Pad

  • Bull Frog
  • Posts: 324
Re: Align Text Routine
« Reply #36 on: June 30, 2009, 10:06:08 AM »
Ah I see.

I entered (setq atdebut t) and nothing different to before happened (no text box).
Searching the Text Align Group CAB013.LSP with notepad didn't show up any atdebut variable?

Everything is fine,can live with the slight variation.
Very useful routine, so thanks a lot!

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #37 on: June 30, 2009, 10:25:16 AM »
See attached lisp with debug code.

Note that Tim Willey has a routine that uses the alignment point. I'll see it I can find it here.

« Last Edit: June 30, 2009, 01:45:11 PM 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.

T.Willey

  • Needs a day job
  • Posts: 5247
Re: Align Text Routine
« Reply #38 on: June 30, 2009, 11:16:57 AM »
Note that Tim Willey has a routine that uses the alignment point. I'll see it I can find it here.

I posted one in this thread here ( if that is the one you're thinking of ):
[ http://www.theswamp.org/index.php?topic=25824.msg310952#msg310952 ]
« Last Edit: June 30, 2009, 01:45:25 PM by CAB »
Tim

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

Please think about donating if this post helped you.

Pad

  • Bull Frog
  • Posts: 324
Re: Align Text Routine
« Reply #39 on: June 30, 2009, 01:26:25 PM »
Thanks Tim.
Your lu.lsp lines them up perfectly.
CAB what I really liked about yours is that it fixed the line spacing at the same time.
So i'lll stick with your routine and maybe run the lu.lsp after.

Cheers

CAB

  • Global Moderator
  • Seagull
  • Posts: 10395
Re: Align Text Routine
« Reply #40 on: June 30, 2009, 01:52:23 PM »
That's the one Tim, right under my nose.  :?
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: 10395
Re: Align Text Routine
« Reply #41 on: October 14, 2009, 06:01:34 PM »
Minor update.

<edit : Modified version 14a>
« Last Edit: October 15, 2009, 10:25:53 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.

antistar

  • Newt
  • Posts: 96
Re: Align Text Routine
« Reply #42 on: April 03, 2012, 10:09:33 AM »
Minor update.

<edit : Modified version 14a>

CAB,
Great work, is very useful for me.
But does not support horizontal alignment?

GDF

  • Water Moccasin
  • Posts: 2059
Re: Align Text Routine
« Reply #43 on: April 03, 2012, 05:10:39 PM »
Check out this routine for stacking dtext:
TIP1483.LSP: TXTSTACK.LSP   Restack Text   (C)1998, Terry W. Dotson
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64