**Lisp routine to move text or mtext to midpoint of 2 points**

Good morning all,

 

Does anyone have a iisp routine that they can share that will first make mtext or text insertion point as MC for moving purposes and then be able move it to "mid between 2 points"? The text or mtext does not need to keep MC insertion point after moving it. I sure would appreciate it. I need to move alot of text on a nameplate schedule and want it to look professional. Cab wrote one years ago that works great if you have a rectangle but I need it to work for mid between 2 points.

 

Link to Cab's post:

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/move-mtext-to-center-of-rectangle/td-p/2632882

 

 

Thank you for reading,

Dave

Post a sample drawing.

For text justification, see post 3 in http://www.cadtutor.net/forum/showthread.php?65281-Text-Justification-Lisp

 

For centering text between two points, find your solution in http://www.cadtutor.net/forum/showthread.php?90741

 

 

Steve

ronjonp, attached is part of an example drawing

EXAMPLE.dwg

You move each one of these texts one at a time ? Do you have code that generates the table?

I don't mind moving one at a time. The table is generated manually. I just would like something to pick the text from middle center and picking 2 endpoints to center text. Did you happen to see Cab's lisp? It works but only if the second point is a rectangle. I would like to choose 2 points.

IMO .. the first thing that should be done is figure out how to generate the table automatically. Then you can format to whatever needed.

I have other type of drawings that use different size tables/schedules

I have other type of drawings that use different size tables/schedules

 

This is still a task to be automated...

 

Here's some quick code to help you with your manual process.

(defun c:foo (/ _mid e p p1 p2)
 (defun _mid (p1 p2) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.)))
 ;; RJP - 03.22.2018
 (if (and (setq p1 (getpoint "\nSpecify first corner point: "))
   (setq p2 (getcorner p1 "\nSpecify other corner point: "))
   (setq e (ssget "_C" p1 p2 '((0 . "*text"))))
   (setq e (vlax-ename->vla-object (ssname e 0)))
   (vlax-write-enabled-p e)
     )
   (progn (vla-getboundingbox e 'll 'ur)
   (setq p (mapcar 'vlax-safearray->list (list ll ur)))
   (vlax-invoke e 'move (_mid (car p) (cadr p)) (_mid p1 p2))
   )
 )
 (princ)
)
(vl-load-com)

I will try that and let you know. Thank you very much ronjonp!

ronjonp

mid between 2 points

the text is not necessarily already near the two points so the crossing ssget wil pick something else or maybe nothing, will need 3 picks text & p1 p2, like your _mid idea with bounding box will use as a library routine.

 

 

;; Ronjonp - 03.22.2018 mid pt of two pts
(defun _mid (p1 p2) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.)))
; modified by Alan H basicly supports any object that can have a bounding box 03.23.2018

(defun c:foo (/ e p p1 p2)
(setq e (vlax-ename->vla-object (car (entsel "pick object"))))
(vla-getboundingbox e 'll 'ur)
(setq p (mapcar 'vlax-safearray->list (list ll ur)))
(setq p1 (getpoint "pick 1st point"))
(setq p2 (getpoint "pick 2nd point"))
(vlax-invoke e 'move (_mid (car p) (cadr p)) (_mid p1 p2))
(princ)
)
(vl-load-com)
(c:foo)

 

tested on blocks, *text, objects, lines etc

Edited March 23, 2018 by BIGAL

ronjonp the text is not necessarily already near the two points so the crossing ssget wil pick something else or maybe nothing, will need 3 picks text & p1 p2, like your _mid idea with bounding box will use as a library routine.

 

 

;; Ronjonp - 03.22.2018 mid pt of two pts
(defun _mid (p1 p2) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.)))
; modified by Alan H basicly supports any object that can have a bounding box 03.23.2018

(defun c:foo (/ e p p1 p2)
(setq e (vlax-ename->vla-object (car (entsel "pick object"))))
(vla-getboundingbox e 'll 'ur)
(setq p (mapcar 'vlax-safearray->list (list ll ur)))
(setq p1 (getpoint "pick 1st point"))
(setq p2 (getpoint "pick 2nd point"))
(vlax-invoke e 'move (_mid (car p) (cadr p)) (_mid p1 p2))
(princ)
)
(vl-load-com)
(c:foo)

 

tested on blocks, *text, objects, lines etc

My code is based on the sample drawing so it should work.

Ronjonp really the problem could be solved by using a table which is what you have hinted at, the central text is supported in a table. I did not look at sample dwg, but took it on face value move text to a point. I am sure it will be usefull.

 

Re the numbers in a shape you can get TTF that will do this sort of stuff, I think its dingbats has 0-9 in a circle but I have a TTF that allows for numbers 10+ it makes it as two part text 7+5 = 75

 

Thinking a bit more re sample dwg, 1 pick maybe all done !

 

Pick the text do a bpoly this gives corners of text. Only gotcha is text pick point must be inside a rectang. Then do bpoly outside text box -lower left a fraction ?

 

A start just to se if I could manually get somewhere

(setq ent (entsel))
(setq pt (cadr ent))
(command "bpoly" pt "")
(setq obj1 (vlax-ename->vla-object (entlast)))
(vla-getboundingbox obj1 'll 'ur)
(setq p (mapcar 'vlax-safearray->list (list ll ur)))
(setq p3 (list ( - (car (nth 0 p)) 0.00001) (cadr (nth 0 p))))
(command "bpoly" p3 "")
(setq obj2 (vlax-ename->vla-object (entlast)))
(vla-getboundingbox obj2 'll 'ur)
(setq p2 (mapcar 'vlax-safearray->list (list ll ur)))

Edited March 23, 2018 by BIGAL

I'm sure code could be written to cleanup the table in one pick, but I don't have time right now. Plus I still feel that the process of making the table needs to be automated, but that's just me ( I'm SUPER impatient & lazy ).

... but that's just me ( I'm SUPER impatient & lazy ).

 

weekend used to be lazy mood

Thanks nice idea - BIGAL bpoly

hiccups: if more than 2 TEXT entities in one cell, then all overlapped

 

Try this click at the outer box only..

(vl-load-com)
(defun c:m2cen (/ ss en i lp pl tx p obj box ll rr)
;hanhphuc 23.03.2018 
 (and 
   (while (not ss)
     (setq
ss (ssget "_:S:E+."
	  '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1) (90 . 4))
   )
     )
   )
   (setq lp '((en)(mapcar 'cdr (vl-remove-if ''((x) (/= (car x) 10)) (entget en))))
  en  (ssname ss 0)
  pl (lp en)
   	  tx (ssget "_WP" (mapcar ''((x)(trans x en 1)) pl) '((0 . "*TEXT"))))
   (repeat (setq i (sslength tx))
     (setq obj (vlax-ename->vla-object (ssname tx (setq i (1- i) )))
    p 	(vlax-get obj 'InsertionPoint))
           (if (vlax-property-available-p obj 'AttachmentPoint)
 	(vla-put-AttachmentPoint obj 5)
      )
     (and
(setq box (bpoly (trans p 0 1)))
(setq pl (lp box)
      mp
	 (reverse
	   (cons
	     0.0
	     (mapcar ''((f) (/ (apply '+ (mapcar 'f pl)) (length pl)))
		     (list cadr car)
	     )
	   )
	 )
)
(entdel box)
(progn
  (vla-getboundingbox obj 'll 'ur)
  (vlax-invoke
    obj
    'move
    (apply 'mapcar
	   (cons ''((a b) (* (+ a b) 0.5))
		 (mapcar 'vlax-safearray->list (list ll ur))
	   )
    )	 
 	mp
  )

)
     )
   )

 )

 (princ)
)

 

p/s: why @OP does not use built-in (command: table) to fill your data?

i prefer activeX addtable method automated is more easy & flexible

Edited March 23, 2018 by hanhphuc
localize ll rr , extra en

Hanhpuc your right actually forgot about something I had done already that is find text inside pline so just pick near text this makes a bpoly of the box and allows for the txt to be found using a "C" with two points, again a single pick, this also gets around a problem if the txt is bottom left and sits just over a line. You are correct though about two texts, would need testing.