Move text using vla-getboundingbox method (non dynamic)

[Happy Hobbit]

This has undoubted been done before but I cannot find a simple(?) lisp to move text objects to a picked x or y value (see picture).

There's Lee Macs Dynamic text align but I'd prefer non dynamic.

There's also CAB's alignall, but I've had a few problems with it.

 

The code I've got is:

(defun c:mtx ( / ap ent obj point1 point2 ss )
 (vl-load-com)
 (setq ap (getpoint "select alignment point"))
 (setq ss (ssget "_:L" '((0 . "TEXT,MTEXT"))))
 (setq ent (ssname ss 0))
 (setq obj (vlax-ename->vla-object ent))
 (if obj
   (progn
     ;;obj is a vla-object
     ;;point1 is the lower left point of the bounding box around the object
     ;;point2 is the upper right point of the bounding box around the object
     (vla-getboundingbox obj 'point1 'point2)
      ;;point1 and point2 are returned as a safearray and need to be converted to a list
     (setq point1 (vlax-safearray->list point1))
     (setq point2 (vlax-safearray->list point2))
     (command  "_.move" ent "" point1 "_none" (list (car ap) (cadr point1) 0.0))
   );; progn
 );; if
 (princ)
 )

 

It crashes on the MOVE command

 

I only added ent because I thought the MOVE command may not work on a vla-object(?)

[Lee Mac]

I don't see anything wrong with your current code, except that it will only operate on the first object in the selection; other than that, it should perform as you have described (at least, for Text/MText at zero rotation and residing in a plane parallel to the WCS plane).

 

Ignoring UCS & rotation issues, you may find it helpful to restructure the code in the following way, so that the lower-left point may be used as a visual aid when specifying the new position:

(defun c:mtx ( / bpt llp sel urp )
   (if (setq sel (ssget "_+.:E:S:L" '((0 . "TEXT,MTEXT"))))
       (progn
           (vla-getboundingbox (vlax-ename->vla-object (ssname sel 0)) 'llp 'urp)
           (setq llp (vlax-safearray->list llp))
           (if (setq bpt (getpoint "\nSpecify alignment point: " llp))
               (command "_.move" sel "" "_non" (list (car llp) 0.0) "_non" (list (car bpt) 0.0))
           )
       )
   )
   (princ)
)
(vl-load-com) (princ)

[Happy Hobbit]

Hello Lee

I don't see anything wrong with your current code...

it didn't work !

.....except that it will only operate on the first object in the selection

I intend to put It in a repeat loop starting with

ssget "_:L

and the usual incrementing ssname functions, etc. Hence the ent function in my code. I always try to get code working on a single item before wrapping a loop around it. I see that your code move the selection set (single item at present) from ssget, rather than the resulting entity. Something like:

 

(defun c:mtx ( / bpt ent i llp sel urp )
 (setq i 0)
 (setq bpt (getpoint "\nSpecify alignment point: " llp))
   (if (setq sel (ssget "_:L" '((0 . "TEXT,MTEXT"))))
	(repeat (sslength sel)
	  (setq ent (ssname sel 0))
	  (vla-getboundingbox (vlax-ename->vla-object ent) 'llp 'urp)
          (setq llp (vlax-safearray->list llp))
	  (command "_.move" ent "" "_non" (list (car llp) 0.0) "_non" (list (car bpt) 0.0))
	  (setq i (1+ i))
        )
     (princ "No Text/Mtext Found")
   )
   (princ)
)
(vl-load-com) (princ)

But it's not working yet.

Soooo I will put the Select Alignment Point at the top of the code, then the repeat loop & move all selected qualifying entities in each turn of the loop.

[Lee Mac]

it didn't work !

 

It worked for me - what error do you receive when testing your original code?

 

Something like:

(defun c:mtx ( / bpt ent i llp sel urp )
 (setq i 0)
 (setq bpt (getpoint "\nSpecify alignment point: " llp))
   (if (setq sel (ssget "_:L" '((0 . "TEXT,MTEXT"))))
       (repeat (sslength sel)
         (setq ent (ssname sel 0))
         (vla-getboundingbox (vlax-ename->vla-object ent) 'llp 'urp)
             (setq llp (vlax-safearray->list llp))
         (command "_.move" ent "" "_non" (list (car llp) 0.0) "_non" (list (car bpt) 0.0))
         (setq i (1+ i))
           )
     (princ "No Text/Mtext Found")
   )
   (princ)
)
(vl-load-com) (princ)

But it's not working yet.

 

Here's why:

 

(setq bpt (getpoint "\nSpecify alignment point: " llp)) ;; 'llp' is not defined at this point

(setq ent (ssname sel 0)) ;; You are always retrieving the first entity in the set

I would suggest:

(defun c:mtx ( / bpt ent idx llp sel )
   (if (and (setq sel (ssget "_:L" '((0 . "TEXT,MTEXT"))))
            (setq bpt (getpoint "\nSpecify alignment point: "))
       )
       (repeat (setq idx (sslength sel))
           (setq ent (ssname sel (setq idx (1- idx))))
           (vla-getboundingbox (vlax-ename->vla-object ent) 'llp 'urp)
           (command "_.move" ent "" "_non" (list (car (vlax-safearray->list llp)) 0.0) "_non" (list (car bpt) 0.0))
       )
   )
   (princ)
)
(vl-load-com) (princ)

You may also find this program helpful.

[Happy Hobbit]

It worked for me - what error do you receive when testing your original code?

It was erroring on the line with the move command in it.

 

Here's why

I realised that the llp was undefined, but couldn't work out where to put it I'm still not too familiar with the VL functions.

 

I would suggest:

That's exactly what I'm after, thanks Lee.

It'll be a doddle to add a align by Y coordinate option as well with that using a initget/cond & the necessary changes to the line:

(command "_.move" ent "" "_non" (list (car (vlax-safearray->list llp)) 0.0) "_non" bpt)

 

You may also find this program helpful.

 

I haven't seen that one before, very good.

[Lee Mac]

It was erroring on the line with the move command in it.

 

What was the error message?

 

That's exactly what I'm after, thanks Lee.

It'll be a doddle to add a align by Y coordinate option as well with that using a initget/cond & the necessary changes to the line:

(command "_.move" ent "" "_non" (list (car (vlax-safearray->list llp)) 0.0) "_non" bpt)

 

You're welcome

 

I haven't seen that one before, very good.

 

Thanks!

[Happy Hobbit]

What was the error message?

I've just retested it & there's no problem **ODD**

 

Since I last tried it the PC has been shut down & restarted later, perhaps the code gliched on something changed whilst the code wasn't fully reloaded

 

I've really no idea, I must have been closer than I thought.

Edited December 14, 2015 by Happy Hobbit

[Happy Hobbit]

In case anyone else can use/improve/adapt it to something else, here's the code I finally settled on:

 

(defun c:altx ( / alignment bpt ent *error* idx llp ofs option ss urp)
 (defun *error* (errmsg)
   (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
     (princ (strcat "\nError: " errmsg)))
   (princ)
 ); end *error*
 (command "UNDO" "BE")
   (if
       (and
	(princ "\n \nSelect Text and/or Mtext to be Aligned")
  	(setq ss (ssget "_:L" '((0 . "TEXT,MTEXT"))))
	(setq bpt (getpoint "\nSpecify Alignment Point: "))
       ); and
     		(progn
	  (initget "Right-of-Point Left-of-Point Above-Point Below-Point")
    	  (setq alignment (cond ((getkword "\nAligned to [Right-of-Point/Left-of-Point/Above-Point/Below-Point] <Right>: "))
	                           ("Right-of-Alignment-Point")))		  
	  (setq ofs (getreal "Specify Offset from Alignment Point <0>"))
	  (setq ofs (if (= ofs nil) 0 ofs))
	  	(repeat (setq idx (sslength ss))
	            (setq ent (ssname ss (setq idx (1- idx))))			    
	            (vla-getboundingbox (vlax-ename->vla-object ent) 'llp 'urp)
		  (cond				
			((eq alignment "Right-of-Point")
			;(command "justifytext" ent "" "ML")
			(command "_.move" ent "" "_non" (list (- (car (vlax-safearray->list llp)) ofs ) 0.0) "_non" (list (car bpt) 0.0))
			)
			((eq alignment "Left-of-Point")
			(command "_.move" ent "" "_non" (list (+ (car (vlax-safearray->list urp)) ofs ) 0.0) "_non" (list (car bpt) 0.0))
			)				
			((eq alignment "Above-Point")
			(command "_.move" ent "" "_non" (list 0.0 (cadr (vlax-safearray->list llp))) "_non" (list 0.0 (+ (cadr bpt) ofs )))
			)
			
			((eq alignment "Below-Point")
			(command "_.move" ent "" "_non" (list 0.0 (cadr (vlax-safearray->list urp))) "_non" (list 0.0 (- (cadr bpt) ofs )))
			)
			
		  );; end cond
	        ); repeat
	);progn
           (princ "No Text/Mtext Found")
   )
 (command "UNDO" "END")
   (princ)
)
(vl-load-com) (princ)