Jump to content
ramimann

ALIGN TEXT TO A PICKED POINT

Recommended Posts

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

Share this post


Link to post
Share on other sites
eldon
Posted (edited)

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

Edited by eldon
amplification

Share this post


Link to post
Share on other sites
ronjonp

Posted HERE too.

Share this post


Link to post
Share on other sites
BIGAL

Yeah Cab offered a lot of solutions.

Share this post


Link to post
Share on other sites
myloveflyer
Posted (edited)
(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 by myloveflyer
  • Like 1

Share this post


Link to post
Share on other sites
ramimann
On 5/2/2019 at 7:32 PM, eldon said:

Almost like Coordinate Filters, but automated to save fingerwork.

Yes..

Share this post


Link to post
Share on other sites
ramimann

Thanks Everybody

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

Share this post


Link to post
Share on other sites
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)

 

Share this post


Link to post
Share on other sites
ronjonp
Posted (edited)

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 by ronjonp

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
Lee Mac
9 hours ago, myloveflyer said:

Cool,Lee

 

Thanks :)

Share this post


Link to post
Share on other sites
ronjonp
12 hours ago, myloveflyer said:

Well Done,RJP

Thanks!

Share this post


Link to post
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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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...