Jump to content

Help: Distance between text and Mtext strings


mhy3sx

Recommended Posts

Hi, I use this code to change the distance between text strings. For single text works fine. I want to update the code to work text and Mtext. Can any one help?

 

(defun MYERR (MSG)
   (if (and (/= MSG "Function cancelled") (/= MSG "console break"))
      (progn
         (princ "\nError: ")
         (princ MSG)
      )
   )
   (setq *error* OLDER)
   (setvar "cmdecho" 1)
   (princ)
)
;---------------------------
;
(defun c:rsp (/ older tmpdis ss sslen ctr ent txtrot just code inspt
               xpt ypt entlis tdisp x y pt theta)
   (setvar "cmdecho" 0)
   (command ".undo" "m")
   (setq older *error*
         *error* myerr
   )
   (initget (+ 1 2 4)) ;disallow negative and zero responses
   (if (= dis nil)
      (progn
         (initget (+ 1 2 4)) ;disallow nul negative and zero responses
         (setq dis (getdist "\nDistance between text strings: "))
      )
      (progn
         (initget (+ 2 4)) ;disallow negative and zero responses
         (setq tmpdis dis
               dis (getdist (strcat "\nDistance between text strings (4 for Layout)<"
                         (rtos dis) ">: " )
                   )
         );close setq
         (if (= dis nil)
            (setq dis tmpdis)
         )
      );close progn
   );close if
   (princ "\nSelect text strings to respace in sequence: ")
   (setq ss (ssget)
         sslen (sslength ss)
         ctr 0  ;initialize counter
   );close setq
   (while (and (/= ss nil) (>= sslen 0) (< ctr sslen))
      (setq ent (ssname ss ctr))
      (if (= ctr 0)
         (progn
            (setq txtrot (cdr (assoc 50 (entget ent)))
                  just (cdr (assoc 72 (entget ent)))
            )
            (if (> just 0)
               (setq code 11)    ;non-left justified
               (setq code 10)    ;left justified
            )
            (setq inspt (cdr (assoc code (entget ent)))
                  xpt (car inspt)
                  ypt (cadr inspt)
            );close setq
         );close progn
         (progn
;------------------------------------------------------------------------
;lets take different action depending on rotation angle of text entities
;------------------------------------------------------------------------

;---------------------------------------------------
;Lets also check text justification mode.
;We should use group code 10 for left justified
;text.  All others we should use group code 11
;this will maintain justification
;---------------------------------------------------

            (cond
               (   (< txtrot (* 0.5 pi))       ;if rotation angle <90 deg
                   (setq entlis (entget ent)
                         just (cdr (assoc 72 entlis))
                   )
                   (if (> just 0)
                      (setq code 11)
                      (setq code 10)
                   )
                   (setq tdisp (* ctr dis)
                         x (+ xpt (* tdisp (sin txtrot)))
                         y (- ypt (* tdisp (cos txtrot)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 1st cond

               (   (and (< txtrot pi) (>= txtrot (* 0.5 pi))) ;if rotation angle <180 & >= 90 deg
                   (setq entlis (entget ent)
                         theta (- txtrot (* 0.5 pi))
                         tdisp (* ctr dis)
                         x (+ xpt (* tdisp (cos theta)))
                         y (+ ypt (* tdisp (sin theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 2nd cond

               (   (and (< txtrot (* 1.5 pi)) (>= txtrot pi)) ;if rot angle <270 & >= 180 deg
                   (setq entlis (entget ent)
                         theta (- txtrot pi)
                         tdisp (* ctr dis)
                         x (- xpt (* tdisp (sin theta)))
                         y (+ ypt (* tdisp (cos theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 3rd cond

               (   (and (< txtrot (* 2.0 pi)) (>= txtrot (* 1.5 pi))) ;if rot angle <360 & >= 270 deg
                   (setq entlis (entget ent)
                         theta (- txtrot (* 1.5 pi))
                         tdisp (* ctr dis)
                         x (- xpt (* tdisp (cos theta)))
                         y (- ypt (* tdisp (sin theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 4th cond
            );close cond text rotation angles
;-------------------------------------------------------------------------
         );close progn
      );close if
      (setq ctr (1+ ctr))  ;increment counter
   );close while
   (setvar "cmdecho" 1)
   (setq *error* older)
   (princ);quiet exit
);close defun respace
(princ);quiet load 

 

Thanks

Link to comment
Share on other sites

At this stage only 1 suggestion (setq ss (ssget) use (setq ss (ssget '( (0 . "*TEXT"))))

Link to comment
Share on other sites

Hi, BIGAL. I try this but working only for text not mtext

 

   (setq ss (ssget '((0 . "TEXT,MTEXT")))
         sslen (sslength ss)
         ctr 0  ;initialize counter
   );close setq

 

Is something else to change?

 

Thanks

Link to comment
Share on other sites

Working for me, copy this to command line and pick the mtext, (entget (car (entsel "\nPick mtext "))) you should see (0 . "MTEXT") about 2nd item. If not post what it shows for the (0 . ????)

Link to comment
Share on other sites

I can not understand. Is not working for me !!

 

(defun MYERR (MSG)
   (if (and (/= MSG "Function cancelled") (/= MSG "console break"))
      (progn
         (princ "\nError: ")
         (princ MSG)
      )
   )
   (setq *error* OLDER)
   (setvar "cmdecho" 1)
   (princ)
)
;---------------------------
;
(defun c:rsp (/ older tmpdis ss sslen ctr ent txtrot just code inspt
               xpt ypt entlis tdisp x y pt theta)
   (setvar "cmdecho" 0)
   (command ".undo" "m")
   (setq older *error*
         *error* myerr
   )
   (initget (+ 1 2 4)) ;disallow negative and zero responses
   (if (= dis nil)
      (progn
         (initget (+ 1 2 4)) ;disallow nul negative and zero responses
         (setq dis (getdist "\nDistance between text strings: "))
      )
      (progn
         (initget (+ 2 4)) ;disallow negative and zero responses
         (setq tmpdis dis
               dis (getdist (strcat "\nDistance between text strings (4 for Layout)<"
                         (rtos dis) ">: " )
                   )
         );close setq
         (if (= dis nil)
            (setq dis tmpdis)
         )
      );close progn
   );close if
   (princ "\nSelect text strings to respace in sequence: ")
   (setq ss (ssget '((0 . "TEXT,MTEXT")))
         sslen (sslength ss)
         ctr 0  ;initialize counter
   );close setq
   (while (and (/= ss nil) (>= sslen 0) (< ctr sslen))
      (setq ent (ssname ss ctr))
      (if (= ctr 0)
         (progn
            (setq txtrot (cdr (assoc 50 (entget ent)))
                  just (cdr (assoc 72 (entget ent)))
            )
            (if (> just 0)
               (setq code 11)    ;non-left justified
               (setq code 10)    ;left justified
            )
            (setq inspt (cdr (assoc code (entget ent)))
                  xpt (car inspt)
                  ypt (cadr inspt)
            );close setq
         );close progn
         (progn
;------------------------------------------------------------------------
;lets take different action depending on rotation angle of text entities
;------------------------------------------------------------------------

;---------------------------------------------------
;Lets also check text justification mode.
;We should use group code 10 for left justified
;text.  All others we should use group code 11
;this will maintain justification
;---------------------------------------------------

            (cond
               (   (< txtrot (* 0.5 pi))       ;if rotation angle <90 deg
                   (setq entlis (entget ent)
                         just (cdr (assoc 72 entlis))
                   )
                   (if (> just 0)
                      (setq code 11)
                      (setq code 10)
                   )
                   (setq tdisp (* ctr dis)
                         x (+ xpt (* tdisp (sin txtrot)))
                         y (- ypt (* tdisp (cos txtrot)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 1st cond

               (   (and (< txtrot pi) (>= txtrot (* 0.5 pi))) ;if rotation angle <180 & >= 90 deg
                   (setq entlis (entget ent)
                         theta (- txtrot (* 0.5 pi))
                         tdisp (* ctr dis)
                         x (+ xpt (* tdisp (cos theta)))
                         y (+ ypt (* tdisp (sin theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 2nd cond

               (   (and (< txtrot (* 1.5 pi)) (>= txtrot pi)) ;if rot angle <270 & >= 180 deg
                   (setq entlis (entget ent)
                         theta (- txtrot pi)
                         tdisp (* ctr dis)
                         x (- xpt (* tdisp (sin theta)))
                         y (+ ypt (* tdisp (cos theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 3rd cond

               (   (and (< txtrot (* 2.0 pi)) (>= txtrot (* 1.5 pi))) ;if rot angle <360 & >= 270 deg
                   (setq entlis (entget ent)
                         theta (- txtrot (* 1.5 pi))
                         tdisp (* ctr dis)
                         x (- xpt (* tdisp (cos theta)))
                         y (- ypt (* tdisp (sin theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 4th cond
            );close cond text rotation angles
;-------------------------------------------------------------------------
         );close progn
      );close if
      (setq ctr (1+ ctr))  ;increment counter
   );close while
   (setvar "cmdecho" 1)
   (setq *error* older)
   (princ);quiet exit
);close defun respace
(princ);quiet load 

 

test.dwg

Link to comment
Share on other sites

What if you change your condition?

(if (> just 0)

to

(if (and (eq (cdr (assoc 0 (entget ent))) "TEXT") (> just 0))

in the lines 51 and 77

Link to comment
Share on other sites

Hi Tsuky.  I use your advice. Works, but not properly. Move all text together and all mtext together, to 0. The idea is to adjust all the select text, mtext and change the distance between them in the same place.

 

(defun MYERR (MSG)
   (if (and (/= MSG "Function cancelled") (/= MSG "console break"))
      (progn
         (princ "\nError: ")
         (princ MSG)
      )
   )
   (setq *error* OLDER)
   (setvar "cmdecho" 1)
   (princ)
)
;---------------------------
;
(defun c:rsp2 (/ older tmpdis ss sslen ctr ent txtrot just code inspt
               xpt ypt entlis tdisp x y pt theta)
   (setvar "cmdecho" 0)
   (command ".undo" "m")
   (setq older *error*
         *error* myerr
   )
   (initget (+ 1 2 4)) ;disallow negative and zero responses
   (if (= dis nil)
      (progn
         (initget (+ 1 2 4)) ;disallow nul negative and zero responses
         (setq dis (getdist "\nDistance between text strings: "))
      )
      (progn
         (initget (+ 2 4)) ;disallow negative and zero responses
         (setq tmpdis dis
               dis (getdist (strcat "\nDistance between text strings (4 for Layout)<"
                         (rtos dis) ">: " )
                   )
         );close setq
         (if (= dis nil)
            (setq dis tmpdis)
         )
      );close progn
   );close if
   (princ "\nSelect text strings to respace in sequence: ")
   (setq ss (ssget '((0 . "TEXT,MTEXT")))
         sslen (sslength ss)
         ctr 0  ;initialize counter
   );close setq
   (while (and (/= ss nil) (>= sslen 0) (< ctr sslen))
      (setq ent (ssname ss ctr))
      (if (= ctr 0)
         (progn
            (setq txtrot (cdr (assoc 50 (entget ent)))
                  just (cdr (assoc 72 (entget ent)))
            )
            (if (> just 0)
               (setq code 11)    ;non-left justified
               (setq code 10)    ;left justified
            )
            (setq inspt (cdr (assoc code (entget ent)))
                  xpt (car inspt)
                  ypt (cadr inspt)
            );close setq
         );close progn
         (progn
;------------------------------------------------------------------------
;lets take different action depending on rotation angle of text entities
;------------------------------------------------------------------------

;---------------------------------------------------
;Lets also check text justification mode.
;We should use group code 10 for left justified
;text.  All others we should use group code 11
;this will maintain justification
;---------------------------------------------------

            (cond
               (   (< txtrot (* 0.5 pi))       ;if rotation angle <90 deg
                   (setq entlis (entget ent)
                         just (cdr (assoc 72 entlis))
                   )
                  (if (and (eq (cdr (assoc 0 (entget ent))) "TEXT,MTEXT") (> just 0))
                      (setq code 11)
                      (setq code 10)
                   )
                   (setq tdisp (* ctr dis)
                         x (+ xpt (* tdisp (sin txtrot)))
                         y (- ypt (* tdisp (cos txtrot)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 1st cond

               (   (and (< txtrot pi) (>= txtrot (* 0.5 pi))) ;if rotation angle <180 & >= 90 deg
                   (setq entlis (entget ent)
                         theta (- txtrot (* 0.5 pi))
                         tdisp (* ctr dis)
                         x (+ xpt (* tdisp (cos theta)))
                         y (+ ypt (* tdisp (sin theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 2nd cond

               (   (and (< txtrot (* 1.5 pi)) (>= txtrot pi)) ;if rot angle <270 & >= 180 deg
                   (setq entlis (entget ent)
                         theta (- txtrot pi)
                         tdisp (* ctr dis)
                         x (- xpt (* tdisp (sin theta)))
                         y (+ ypt (* tdisp (cos theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 3rd cond

               (   (and (< txtrot (* 2.0 pi)) (>= txtrot (* 1.5 pi))) ;if rot angle <360 & >= 270 deg
                   (setq entlis (entget ent)
                         theta (- txtrot (* 1.5 pi))
                         tdisp (* ctr dis)
                         x (- xpt (* tdisp (cos theta)))
                         y (- ypt (* tdisp (sin theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 4th cond
            );close cond text rotation angles
;-------------------------------------------------------------------------
         );close progn
      );close if
      (setq ctr (1+ ctr))  ;increment counter
   );close while
   (setvar "cmdecho" 1)
   (setq *error* older)
   (princ);quiet exit
);close defun respace
(princ);quiet load 

 

Any other ideas?

 

Thanks

Link to comment
Share on other sites

I did another one change exactly by the advices of BIGAL and Tsuky. The problem is that move the text to 0,0 and change the possitons of text and mtext. Take all the text together and all mtext together. I want to keep all text and mtext in their position and change only the distance between. Any ideas?

 

 

(defun MYERR (MSG)
   (if (and (/= MSG "Function cancelled") (/= MSG "console break"))
      (progn
         (princ "\nError: ")
         (princ MSG)
      )
   )
   (setq *error* OLDER)
   (setvar "cmdecho" 1)
   (princ)
)
;---------------------------
;
(defun c:rsp (/ older tmpdis ss sslen ctr ent txtrot just code inspt
               xpt ypt entlis tdisp x y pt theta)
   (setvar "cmdecho" 0)
   (command ".undo" "m")
   (setq older *error*
         *error* myerr
   )
   (initget (+ 1 2 4)) ;disallow negative and zero responses
   (if (= dis nil)
      (progn
         (initget (+ 1 2 4)) ;disallow nul negative and zero responses
         (setq dis (getdist "\nDistance between text strings: "))
      )
      (progn
         (initget (+ 2 4)) ;disallow negative and zero responses
         (setq tmpdis dis
               dis (getdist (strcat "\nDistance between text strings (4 for Layout)<"
                         (rtos dis) ">: " )
                   )
         );close setq
         (if (= dis nil)
            (setq dis tmpdis)
         )
      );close progn
   );close if
   (princ "\nSelect text strings to respace in sequence: ")
   (setq ss (ssget '((0 . "*TEXT")))
         sslen (sslength ss)
         ctr 0  ;initialize counter
   );close setq
   (while (and (/= ss nil) (>= sslen 0) (< ctr sslen))
      (setq ent (ssname ss ctr))
      (if (= ctr 0)
         (progn
            (setq txtrot (cdr (assoc 50 (entget ent)))
                  just (cdr (assoc 72 (entget ent)))
            )
            (if (> just 0)
               (setq code 11)    ;non-left justified
               (setq code 10)    ;left justified
            )
            (setq inspt (cdr (assoc code (entget ent)))
                  xpt (car inspt)
                  ypt (cadr inspt)
            );close setq
         );close progn
         (progn
;------------------------------------------------------------------------
;lets take different action depending on rotation angle of text entities
;------------------------------------------------------------------------

;---------------------------------------------------
;Lets also check text justification mode.
;We should use group code 10 for left justified
;text.  All others we should use group code 11
;this will maintain justification
;---------------------------------------------------

            (cond
               (   (< txtrot (* 0.5 pi))       ;if rotation angle <90 deg
                   (setq entlis (entget ent)
                         just (cdr (assoc 72 entlis))
                   )
                   (if (and (eq (cdr (assoc 0 (entget ent))) "TEXT") (> just 0))
                      (setq code 11)
                      (setq code 10)
                   )
                   (setq tdisp (* ctr dis)
                         x (+ xpt (* tdisp (sin txtrot)))
                         y (- ypt (* tdisp (cos txtrot)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 1st cond

               (   (and (< txtrot pi) (>= txtrot (* 0.5 pi))) ;if rotation angle <180 & >= 90 deg
                   (setq entlis (entget ent)
                         theta (- txtrot (* 0.5 pi))
                         tdisp (* ctr dis)
                         x (+ xpt (* tdisp (cos theta)))
                         y (+ ypt (* tdisp (sin theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 2nd cond

               (   (and (< txtrot (* 1.5 pi)) (>= txtrot pi)) ;if rot angle <270 & >= 180 deg
                   (setq entlis (entget ent)
                         theta (- txtrot pi)
                         tdisp (* ctr dis)
                         x (- xpt (* tdisp (sin theta)))
                         y (+ ypt (* tdisp (cos theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 3rd cond

               (   (and (< txtrot (* 2.0 pi)) (>= txtrot (* 1.5 pi))) ;if rot angle <360 & >= 270 deg
                   (setq entlis (entget ent)
                         theta (- txtrot (* 1.5 pi))
                         tdisp (* ctr dis)
                         x (- xpt (* tdisp (cos theta)))
                         y (- ypt (* tdisp (sin theta)))
                         pt (list x y)
                         entlis (subst (cons code pt) (assoc code entlis) entlis)
                   );close setq
                   (entmod entlis)
               );close 4th cond
            );close cond text rotation angles
;-------------------------------------------------------------------------
         );close progn
      );close if
      (setq ctr (1+ ctr))  ;increment counter
   );close while
   (setvar "cmdecho" 1)
   (setq *error* older)
   (princ);quiet exit
);close defun respace
(princ);quiet load 

 

Thanks

test.dwg

Link to comment
Share on other sites

I find this code, is similar , working better but not support mtext. Can any one help?

 

(defun c:daly (/ tHeight insPoint dtSet oldDisMode errFlag 
                 sStr tAlignPt tAlignment disDelta dtList 
                 oldStrDis hitStr alignList oldMinPt maxPt
	         minPt oldAlign oldDirect)
  
  (vl-load-com) 

  (defun texAlign (item /)
    (if(= daly:Direct "Y")
      (progn
          (setq disDelta(- disDelta daly:strDis)); end setq 
      (vla-put-Alignment (car str) tAlignment) 
      (cond 
   ((= tAlignment 0) 
      (vla-put-InsertionPoint (car str) 
        (vlax-3D-Point(car insPoint) 
          (+ disDelta(cadr insPoint))(nth 2 insPoint))) 
    ) 
   ((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14)) 
      (vla-put-TextAlignmentPoint (car str) 
        (vlax-3D-Point(car tAlignPt) 
          (+ disDelta(cadr tAlignPt))(nth 2 tAlignPt))) 
    ) 
   ((member tAlignment '(3 5)) 
    (princ "\nCan't align string with Aligned or Fit alignment ") 
    ) 
   ); end cond
	); end progn
      (progn
      (setq disDelta(- disDelta daly:strDis)); end setq 
      (vla-put-Alignment (car str) tAlignment) 
      (cond 
   ((= tAlignment 0) 
      (vla-put-InsertionPoint (car str) 
        (vlax-3D-Point(-(car insPoint)disDelta)
          (cadr insPoint)(nth 2 insPoint))) 
    ) 
   ((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14)) 
      (vla-put-TextAlignmentPoint (car str) 
        (vlax-3D-Point(-(car tAlignPt)disDelta)
          (cadr tAlignPt)(nth 2 tAlignPt))) 
    ) 
   ((member tAlignment '(3 5)) 
    (princ "\nCan't align string with Aligned or Fit alignment ") 
    ) 
   ); end cond
      ); end progn
    ); end if
    ); end of texAlign

  (if(not daly:Direct)(setq daly:Direct "Y"))
  (setq oldDirect daly:Direct)
  (if(not daly:Align)(setq daly:Align "H"))
  (setq oldAlign daly:Align)
  (if(not daly:disMode)(setq daly:disMode "S")) 
  (setq oldDisMode daly:disMode) 
  (if(not daly:strDis)(setq daly:strDis 4.167)) 
  (setq oldStrDis daly:strDis)
  (initget "Y X")
  (setq daly:Direct 
    (getkword 
      (strcat "\nSpecify alignment direction [X-axis/Y-axis] <"daly:Direct">: ")))
  (if(null daly:Direct)(setq daly:Direct oldDirect))
  (initget "H L C M R TL TC TR ML MC MR BL BC BR")
  (setq daly:Align 
    (getkword 
      (strcat "\nSpecify justification [Hitest string/Left/Center/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR] <"daly:Align">: "))
	alignList '(("L" 0)("C" 1)("R" 2)("M" 4)("TL" 6)("TC" 7)("TR" 8)("ML" 9)("MC" 10)("MR" 11)("BL" 12)("BC" 13)("BR" 14))
		    ); end setq 
  (if(null daly:Align)(setq daly:Align oldAlign))
  (initget "S C") 
  (setq daly:disMode 
    (getkword 
      (strcat "\nSpecify distance between strings [Standard/Custom] <"daly:disMode">: "))) 
  (if(null daly:disMode)(setq daly:disMode oldDisMode)) 
  (if(= daly:disMode "C") 
    (progn 
    (setq daly:strDis(getdist(strcat "\nSpecify Custom distance <"(rtos daly:strDis)">: "))) 
    (if(null daly:strDis)(setq daly:strDis oldStrDis)) 
    (princ(strcat "\nCustom distance is "(rtos daly:strDis))) 
     ); end progn 
    ); end if
  (while T
  (princ "\n<<< Select DText and press Enter or Esc to Quit >>> ") 
   (if 
     (setq dtSet(ssget '((0 . "TEXT")))) 
    (progn
      (if(= "Y" daly:Direct)
      (setq dtList(vl-sort(mapcar 
           '(lambda (x)(list x 
         (+(cadr(vlax-safearray->list 
             (vlax-variant-value 
               (vla-get-InsertionPoint x)))) 
                 (cadr(vlax-safearray->list 
             (vlax-variant-value 
               (vla-get-TextAlignmentPoint x))))))) 
       (mapcar 'vlax-ename->vla-object 
                  (vl-remove-if 'listp 
                     (mapcar 'cadr(ssnamex dtSet)))))
           (function(lambda(a b)(>(cadr a)(cadr b))))))

	(setq dtList(vl-sort(mapcar 
           '(lambda (x)(list x 
         (+(car(vlax-safearray->list 
             (vlax-variant-value 
               (vla-get-InsertionPoint x)))) 
                 (car(vlax-safearray->list 
             (vlax-variant-value 
               (vla-get-TextAlignmentPoint x))))))) 
       (mapcar 'vlax-ename->vla-object 
                  (vl-remove-if 'listp 
                     (mapcar 'cadr(ssnamex dtSet)))))
           (function(lambda(a b)(<(cadr a)(cadr b))))))
	      ); end if
   
	    (setq hitStr(caar dtList))
      
      (if(/= "H" daly:Align)
	(progn
	  (vla-getBoundingBox hitStr 'oldMinPt 'MaxPt)
	  (foreach lst alignList
		     (if(=(car lst)daly:Align)
		       (progn
			 (if 
                          (not 
                           (vl-catch-all-error-p 
                            (vl-catch-all-apply 'vla-put-Alignment(list hitStr(cadr lst)))))
			  (progn
			    (vla-getBoundingBox hitStr 'minPt 'maxPt)
			    (vla-move hitStr minPt oldMinPt)
			    ); end progn
			  ); end if
			 ); end progn
		       ); end if
	    ); end foreach
	  ); end progn
	); end if
			 
     (setq tHeight(vla-get-Height hitStr) 
           insPoint(vlax-safearray->list 
                     (vlax-variant-value 
                       (vla-get-InsertionPoint hitStr))) 
           tAlignPt(vlax-safearray->list 
                     (vlax-variant-value 
                       (vla-get-TextAlignmentPoint hitStr))) 
           tAlignment(vla-get-Alignment hitStr) 
           dtList(cdr dtList) 
           disDelta 0.0 
     ); end setq 
    (if(= daly:disMode "S")(setq daly:strDis(* 1.6668 tHeight))) 
      (foreach str dtList 
     (if 
   (not 
       (vl-catch-all-error-p 
            (vl-catch-all-apply 'texAlign (list str)))) 
       (princ) 
       (setq errFlag T) 
       ); end if 
   ); end foreach 
      (if errFlag(princ "\n<!> Some Entities on Locked Layer <!>")) 
  ); end progn 
    (princ "\nStrings isn't selected. ") 
    ); end if
    ); end while
    (princ) 
    ); end of dali

(princ "\nType DALY to Run ")

 

Thanks

test.dwg

Link to comment
Share on other sites

I am just jumping in without reading all topic...

 

Have you tried : (ssget '((0 . "*TEXT")))

Link to comment
Share on other sites

Yes and i try it in the second code but is not working.

 

(defun c:daly (/ tHeight insPoint dtSet oldDisMode errFlag 
                 sStr tAlignPt tAlignment disDelta dtList 
                 oldStrDis hitStr alignList oldMinPt maxPt
	         minPt oldAlign oldDirect)
  
  (vl-load-com) 

  (defun texAlign (item /)
    (if(= daly:Direct "Y")
      (progn
          (setq disDelta(- disDelta daly:strDis)); end setq 
      (vla-put-Alignment (car str) tAlignment) 
      (cond 
   ((= tAlignment 0) 
      (vla-put-InsertionPoint (car str) 
        (vlax-3D-Point(car insPoint) 
          (+ disDelta(cadr insPoint))(nth 2 insPoint))) 
    ) 
   ((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14)) 
      (vla-put-TextAlignmentPoint (car str) 
        (vlax-3D-Point(car tAlignPt) 
          (+ disDelta(cadr tAlignPt))(nth 2 tAlignPt))) 
    ) 
   ((member tAlignment '(3 5)) 
    (princ "\nCan't align string with Aligned or Fit alignment ") 
    ) 
   ); end cond
	); end progn
      (progn
      (setq disDelta(- disDelta daly:strDis)); end setq 
      (vla-put-Alignment (car str) tAlignment) 
      (cond 
   ((= tAlignment 0) 
      (vla-put-InsertionPoint (car str) 
        (vlax-3D-Point(-(car insPoint)disDelta)
          (cadr insPoint)(nth 2 insPoint))) 
    ) 
   ((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14)) 
      (vla-put-TextAlignmentPoint (car str) 
        (vlax-3D-Point(-(car tAlignPt)disDelta)
          (cadr tAlignPt)(nth 2 tAlignPt))) 
    ) 
   ((member tAlignment '(3 5)) 
    (princ "\nCan't align string with Aligned or Fit alignment ") 
    ) 
   ); end cond
      ); end progn
    ); end if
    ); end of texAlign

  (if(not daly:Direct)(setq daly:Direct "Y"))
  (setq oldDirect daly:Direct)
  (if(not daly:Align)(setq daly:Align "H"))
  (setq oldAlign daly:Align)
  (if(not daly:disMode)(setq daly:disMode "S")) 
  (setq oldDisMode daly:disMode) 
  (if(not daly:strDis)(setq daly:strDis 4.167)) 
  (setq oldStrDis daly:strDis)
  (initget "Y X")
  (setq daly:Direct 
    (getkword 
      (strcat "\nSpecify alignment direction [X-axis/Y-axis] <"daly:Direct">: ")))
  (if(null daly:Direct)(setq daly:Direct oldDirect))
  (initget "H L C M R TL TC TR ML MC MR BL BC BR")
  (setq daly:Align 
    (getkword 
      (strcat "\nSpecify justification [Hitest string/Left/Center/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR] <"daly:Align">: "))
	alignList '(("L" 0)("C" 1)("R" 2)("M" 4)("TL" 6)("TC" 7)("TR" 8)("ML" 9)("MC" 10)("MR" 11)("BL" 12)("BC" 13)("BR" 14))
		    ); end setq 
  (if(null daly:Align)(setq daly:Align oldAlign))
  (initget "S C") 
  (setq daly:disMode 
    (getkword 
      (strcat "\nSpecify distance between strings [Standard/Custom] <"daly:disMode">: "))) 
  (if(null daly:disMode)(setq daly:disMode oldDisMode)) 
  (if(= daly:disMode "C") 
    (progn 
    (setq daly:strDis(getdist(strcat "\nSpecify Custom distance <"(rtos daly:strDis)">: "))) 
    (if(null daly:strDis)(setq daly:strDis oldStrDis)) 
    (princ(strcat "\nCustom distance is "(rtos daly:strDis))) 
     ); end progn 
    ); end if
  (while T
  (princ "\n<<< Select DText and press Enter or Esc to Quit >>> ") 
   (if 
     (setq dtSet (ssget '((0 . "*TEXT"))))  
    (progn
      (if(= "Y" daly:Direct)
      (setq dtList(vl-sort(mapcar 
           '(lambda (x)(list x 
         (+(cadr(vlax-safearray->list 
             (vlax-variant-value 
               (vla-get-InsertionPoint x)))) 
                 (cadr(vlax-safearray->list 
             (vlax-variant-value 
               (vla-get-TextAlignmentPoint x))))))) 
       (mapcar 'vlax-ename->vla-object 
                  (vl-remove-if 'listp 
                     (mapcar 'cadr(ssnamex dtSet)))))
           (function(lambda(a b)(>(cadr a)(cadr b))))))

	(setq dtList(vl-sort(mapcar 
           '(lambda (x)(list x 
         (+(car(vlax-safearray->list 
             (vlax-variant-value 
               (vla-get-InsertionPoint x)))) 
                 (car(vlax-safearray->list 
             (vlax-variant-value 
               (vla-get-TextAlignmentPoint x))))))) 
       (mapcar 'vlax-ename->vla-object 
                  (vl-remove-if 'listp 
                     (mapcar 'cadr(ssnamex dtSet)))))
           (function(lambda(a b)(<(cadr a)(cadr b))))))
	      ); end if
   
	    (setq hitStr(caar dtList))
      
      (if(/= "H" daly:Align)
	(progn
	  (vla-getBoundingBox hitStr 'oldMinPt 'MaxPt)
	  (foreach lst alignList
		     (if(=(car lst)daly:Align)
		       (progn
			 (if 
                          (not 
                           (vl-catch-all-error-p 
                            (vl-catch-all-apply 'vla-put-Alignment(list hitStr(cadr lst)))))
			  (progn
			    (vla-getBoundingBox hitStr 'minPt 'maxPt)
			    (vla-move hitStr minPt oldMinPt)
			    ); end progn
			  ); end if
			 ); end progn
		       ); end if
	    ); end foreach
	  ); end progn
	); end if
			 
     (setq tHeight(vla-get-Height hitStr) 
           insPoint(vlax-safearray->list 
                     (vlax-variant-value 
                       (vla-get-InsertionPoint hitStr))) 
           tAlignPt(vlax-safearray->list 
                     (vlax-variant-value 
                       (vla-get-TextAlignmentPoint hitStr))) 
           tAlignment(vla-get-Alignment hitStr) 
           dtList(cdr dtList) 
           disDelta 0.0 
     ); end setq 
    (if(= daly:disMode "S")(setq daly:strDis(* 1.6668 tHeight))) 
      (foreach str dtList 
     (if 
   (not 
       (vl-catch-all-error-p 
            (vl-catch-all-apply 'texAlign (list str)))) 
       (princ) 
       (setq errFlag T) 
       ); end if 
   ); end foreach 
      (if errFlag(princ "\n<!> Some Entities on Locked Layer <!>")) 
  ); end progn 
    (princ "\nStrings isn't selected. ") 
    ); end if
    ); end while
    (princ) 
    ); end of dali

(princ "\nType DALY to Run ")

 

Thanks

Link to comment
Share on other sites

After this (if(= "Y" d:Direct) lots of code to work out start and end maybe missing a progn. I would double check your closing brackets wrapping the various functions. 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...