Lisp to put text (or Mtext) at geometric center of multiple areas

[asdfgh]

Hello everyone, 

 

I have text that i need to put at geo center of multiple polylines, so i want to select the polylines and the text and then text to be put at the geo center of the polylines.

Anyone have lisp for that ?

 

Thank you

[mhupp]

This will ask you to select a text but it could be anything really 

find the midpoint of the bounding box around selected item

ask for polylines to be selected

make a copy the first selected item to the geo center of the polylines

 

;;----------------------------------------------------------------------------;;
;; Copy text to the geo center of polyline(s)
(defun C:foo (/ txt BP SS poly PT newtxt)
  (vl-load-com)
  (setq txt (vlax-ename->vla-object (car (entsel "\nSelect Text to Move"))))
  (vla-getboundingbox txt 'minpt 'maxpt)
  (setq BP (mapcar '/ (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt)) '(2 2 2))) ;midpoint of text
  (prompt "\nSelect Polyline")
  (if (setq SS (ssget '((0 . "*POLYLINE"))))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq PT (osnap (vlax-curve-getStartPoint poly) "gcen"))
      (setq newtxt (vla-copy txt))
      (vla-move newtxt (vlax-3d-point BP) (vlax-3d-point pt)) 
    )
  )
  (princ)
)

 

Edited October 26, 2022 by mhupp
added (vl-load-com)

[asdfgh]

49 minutes ago, mhupp said:

This will ask you to select a text but it could be anything really 

find the midpoint of the bounding box around selected item

ask for polylines to be selected

make a copy the first selected item to the geo center of the polylines

 

;;----------------------------------------------------------------------------;;
;; Copy text to the geo center of polyline(s)
(defun C:foo (/ txt BP SS poly PT newtxt)
  (setq txt (vlax-ename->vla-object (car (entsel "\nSelect Text to Move"))))
  (vla-getboundingbox txt 'minpt 'maxpt)
  (setq BP (mapcar '/ (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt)) '(2 2 2))) ;midpoint of text
  (prompt "\nSelect Polyline")
  (if (setq SS (ssget '((0 . "*POLYLINE"))))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq PT (osnap (vlax-curve-getStartPoint poly) "gcen"))
      (setq newtxt (vla-copy txt))
      (vla-move newtxt BP pt)
    )
  )
  (princ)
)

 

Thank you for your reply,

i don't know but it doesn't seem to work well.

you can try it on the attached file

 

new block.dwg

[lrm]

The center of the bounding box is not the same as the centroid.

 

Perhaps the program could use the selected polylines to create regions that were then unioned. Massprop could then be used to determine the centroid for the collection of regions.  But how do you access the results of massprop in vlisp?

 

Edited October 26, 2022 by lrm

[mhupp]

Maybe its because I didn't have (vl-load-com) its there now.

but everything is working on this end.

https://ibb.co/j8HPK1x

 

@lrm bounding box is for the text only.

[asdfgh]

14 minutes ago, mhupp said:

Maybe its because I didn't have (vl-load-com) its there now.

but everything is working on this end.

https://ibb.co/j8HPK1x

 

@lrm bounding box is for the text only.

it gives me this error when i try it

[Tharwat]

13 minutes ago, asdfgh said:

it gives me this error when i try it

Try it with vlax-invoke or convert the coordinates to variant as the error message indicates to.

(vla-move newtxt (vlax-3d-point BP) (vlax-3d-point pt)) ;; replaced with (vla-move newtxt BP pt)

 

[asdfgh]

4 minutes ago, Tharwat said:

Try it with vlax-invoke or convert the coordinates to variant as the error message indicates to.

(vla-move newtxt (vlax-3d-point BP) (vlax-3d-point pt)) ;; replaced with (vla-move newtxt BP pt)

 

That worked so well.

Thank you so much

[Tharwat]

3 minutes ago, asdfgh said:

That worked so well.

Thank you so much

All credits to @mhupp  

Happy coding.

[BIGAL]

Gcen is a snap that can be used to do just that. Must be say closed pline to work.

 

(setq pt (osnap (vlax-curve-getStartPoint (vlax-ename->vla-object (car  (entsel "Pick obj")))) "gcen"))

 

Edited October 27, 2022 by BIGAL