ALIGN TEXT TO A PICKED POINT

[ramimann]

Hello Everyone
I need a code that can align text (from X or Y of insertion point) to "x" or "y" of a picked point.In fact, when I pick a point,the word will move to that X,maintaining the Y coordinate or to the Y of picked point,maintaining the X coordinate. Does anybody have such a lisp?
Thanks in advance

[tombu]

Also at: http://www.theswamp.org/index.php?action=post;topic=55138.0;last_msg=594284

and https://forums.augi.com/showthread.php?173555-Align-Text-to-picked-point

[eldon]

Almost like Move with Coordinate Filters, but automated to save fingerwork.

Edited May 2, 2019 by eldon
amplification

[ronjonp]

Posted HERE too.

[BIGAL]

Yeah Cab offered a lot of solutions.

[myloveflyer]

(defun c:Text_Alignment (/ selobjs oldcmdecho)
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq selobjs (ssget '((0 . "TEXT"))))
  (process selobjs)
  (setvar "cmdecho" oldcmdecho)
  (princ)
)
(defun process (selobjs      /        amode     apnt    apnt_x
        apnt_y      count        objname   vlaxobj    MinPoint
        MaxPoint  minext   maxext   ext_l    ext_r
        ext_m      tpnt
           )
  (initget "L M R")
  (setq    amode (getkword
        "\nSelect alignment [Left Align (L) / Center (M) / Right Align (R)] <Center >:"
          )
  )
  (if (not amode)
    (setq amode "M")
  )
  (initget 1)
  (setq apnt (getpoint "\nSelect the alignment point of the horizontal alignment direction："))
  (setq    apnt_x (car apnt)
    apnt_y (cadr apnt)
  )
  (vl-load-com)
  (setq count 0)
  (repeat (sslength selobjs)
    (setq objname (ssname selobjs count))
    (setq vlaxobj (vlax-ename->vla-object objname))
    (setq MinPoint (vlax-make-variant))
    (setq MaxPoint (vlax-make-variant))
    (vla-GetBoundingBox vlaxobj 'MinPoint 'MaxPoint)
    (setq minext (vlax-safearray->list MinPoint))
    (setq maxext (vlax-safearray->list MaxPoint))
    (setq ext_l (car minext))
    (setq ext_r (car maxext))
    (setq ext_m (+ (/ (abs (- ext_l ext_r)) 2) ext_l))
    (cond
      ((= amode "L")
       (setq tpnt (list ext_l apnt_y))
      )
      ((= amode "M")
       (setq tpnt (list ext_m apnt_y))
      )
      ((= amode "R")
       (setq tpnt (list ext_r apnt_y))
      )
    )
    (if    tpnt
      (command "_move" objname "" "non" tpnt "non" apnt)
    )
    (setq count (1+ count))
  )
)

This program only aligns text (no text spacing is considered).

Edited May 6, 2019 by myloveflyer

[ramimann]

On 5/2/2019 at 7:32 PM, eldon said:

Almost like Coordinate Filters, but automated to save fingerwork.

Yes..

[ramimann]

Thanks Everybody

"Text_Alignment" by Myloveflyer is very good but it lacks the vertical alignment..Please

[Lee Mac]

The following is loosely based on my Align Text program - the commands are ATX & ATY:

(defun c:atx ( / l )
    (if (setq l (getinput))
        (apply 'at (cons (lambda ( a b ) (list (car a) (cadr b) (caddr b))) l))
    )
    (princ)
)
(defun c:aty ( / l )
    (if (setq l (getinput))
        (apply 'at (cons (lambda ( a b ) (list (car b) (cadr a) (caddr b))) l))
    )
    (princ)
)
(defun getinput ( / s p )
    (if (and (setq s (ssget "_:L" '((0 . "TEXT"))))
             (setq p (getpoint "\nSpecify alignment point: "))
        )
        (list s p)
    )
)
(defun at ( f s p / i x )
    (repeat (setq i (sslength s))
        (setq i (1- i)
              x (entget (ssname s i))
        )
        (at:puttextinsertion (f p (at:gettextinsertion x)) x)
    )
)
(defun at:getdxfkey ( enx )
    (if (= 0 (cdr (assoc 72 enx)) (cdr (assoc 73 enx))) 10 11)
)
(defun at:gettextinsertion ( enx )
    (cdr (assoc (at:getdxfkey enx) enx))
)
(defun at:puttextinsertion ( ins enx )
    (   (lambda ( key )
            (if (entmod (subst (cons key ins) (assoc key enx) enx))
                (entupd (cdr (assoc -1 enx)))
            )
        )
        (at:getdxfkey enx)
    )
)
(princ)

 

[ronjonp]

This same problem was posted at TheSwamp and Autodesk as well...

 

Not what the OP was asking for but might be useful to someone. Aligns to X/Y picked point based on closest bounding box edge.

(defun c:xy (/ i k ll p p2 s ur)
  ;; RJP » 05.08.2019
  ;; Align selected objects by closest bounding box edge to picked point
  (or (setq k (getenv "AlignStuff2")) (setq k "X"))
  (cond
    ((and (not (initget "X Y"))
	  (setq	k (cond	((getkword (strcat "\nAlignment [X/Y] <" k ">: ")))
			(k)
		  )
	  )
	  (setq p (getpoint "\nPick an alignment point: "))
	  (setq s (ssget ":L"))
     )
     (setenv "AlignStuff2" k)
     (if (= "X" k) (setq i car p (i p)) (setq i cadr p (i p)))
     (foreach b	(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
       (vla-getboundingbox b 'll 'ur)
       (setq p2 (mapcar 'vlax-safearray->list (list ll ur)))
       (setq p2 (car (vl-sort p2 '(lambda (r j) (< (abs (- p (i r))) (abs (- p (i j))))))))
       (vlax-invoke b 'move p2 (subst p (i p2) p2))
     )
    )
  )
  (princ)
)
(vl-load-com)

 

Edited May 8, 2019 by ronjonp

[myloveflyer]

8 hours ago, Lee Mac said:

The following is loosely based on my Align Text program - the commands are ATX & ATY:

(defun c:atx ( / l )
    (if (setq l (getinput))
        (apply 'at (cons (lambda ( a b ) (list (car a) (cadr b) (caddr b))) l))
    )
    (princ)
)
(defun c:aty ( / l )
    (if (setq l (getinput))
        (apply 'at (cons (lambda ( a b ) (list (car b) (cadr a) (caddr b))) l))
    )
    (princ)
)
(defun getinput ( / s p )
    (if (and (setq s (ssget "_:L" '((0 . "TEXT"))))
             (setq p (getpoint "\nSpecify alignment point: "))
        )
        (list s p)
    )
)
(defun at ( f s p / i x )
    (repeat (setq i (sslength s))
        (setq i (1- i)
              x (entget (ssname s i))
        )
        (at:puttextinsertion (f p (at:gettextinsertion x)) x)
    )
)
(defun at:getdxfkey ( enx )
    (if (= 0 (cdr (assoc 72 enx)) (cdr (assoc 73 enx))) 10 11)
)
(defun at:gettextinsertion ( enx )
    (cdr (assoc (at:getdxfkey enx) enx))
)
(defun at:puttextinsertion ( ins enx )
    (   (lambda ( key )
            (if (entmod (subst (cons key ins) (assoc key enx) enx))
                (entupd (cdr (assoc -1 enx)))
            )
        )
        (at:getdxfkey enx)
    )
)
(princ)

 

Cool,Lee

[myloveflyer]

6 hours ago, ronjonp said:

This same problem was posted at TheSwamp and Autodesk as well...

 

Not what the OP was asking for but might be useful to someone. Aligns to X/Y picked point based on closest bounding box edge.

(defun c:xy (/ i k ll p p2 s ur)
  ;; RJP » 05.08.2019
  ;; Align selected objects by closest bounding box edge to picked point
  (or (setq k (getenv "AlignStuff2")) (setq k "X"))
  (cond
    ((and (not (initget "X Y"))
	  (setq	k (cond	((getkword (strcat "\nAlignment [X/Y] <" k ">: ")))
			(k)
		  )
	  )
	  (setq p (getpoint "\nPick an alignment point: "))
	  (setq s (ssget ":L"))
     )
     (setenv "AlignStuff2" k)
     (if (= "X" k) (setq i car p (i p)) (setq i cadr p (i p)))
     (foreach b	(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
       (vla-getboundingbox b 'll 'ur)
       (setq p2 (mapcar 'vlax-safearray->list (list ll ur)))
       (setq p2 (car (vl-sort p2 '(lambda (r j) (< (abs (- p (i r))) (abs (- p (i j))))))))
       (vlax-invoke b 'move p2 (subst p (i p2) p2))
     )
    )
  )
  (princ)
)
(vl-load-com)

 

Well Done,RJP

[Lee Mac]

9 hours ago, myloveflyer said:

Cool,Lee

 

Thanks

[ronjonp]

12 hours ago, myloveflyer said:

Well Done,RJP

Thanks!