Jump to content
notredave

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

Recommended Posts

notredave

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

Share this post


Link to post
Share on other sites
ronjonp

Post a sample drawing.

Share this post


Link to post
Share on other sites
notredave

ronjonp, attached is part of an example drawing

EXAMPLE.dwg

Share this post


Link to post
Share on other sites
ronjonp

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

Share this post


Link to post
Share on other sites
notredave

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.

Share this post


Link to post
Share on other sites
ronjonp

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

Share this post


Link to post
Share on other sites
notredave

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

Share this post


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

Share this post


Link to post
Share on other sites
notredave

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

Share this post


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

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

Share this post


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

Share this post


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

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

Share this post


Link to post
Share on other sites
ronjonp

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

Share this post


Link to post
Share on other sites
hanhphuc
Posted (edited)
... but that's just me ( I'm SUPER impatient & lazy 8) ).

 

weekend used to be lazy mood :oops:

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 by hanhphuc
localize ll rr , extra en

Share this post


Link to post
Share on other sites
BIGAL

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.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×