Jump to content

MOVE TEXT AND MAKE AN ARROW FROM THE TEXT ORIGINAL POSITION TO ITS NEW POSITION

CADWORKER

By CADWORKER
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Tsuky Community Regular

Tsuky

Posted
Posted (edited)

Hi

You can try this for move text to mleader

  

(vl-load-com)
(defun make_mlead (pt str lay / tmp ptlst arr nw_obj)
  (initget 9)
  (setq
    tmp (getpoint (trans pt 0 1) "\nLeader position: ")
    ptlst (append pt (polar pt (angle pt (trans tmp 1 0)) (distance pt (trans tmp 1 0))))
    arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
  )
  (vlax-safearray-fill arr ptlst)
  (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
  (vla-put-contenttype nw_obj acMTextContent)
  (vla-put-textstring nw_obj str)
  (vla-put-layer nw_obj lay)
  (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
  (vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
  (if (> (car pt) (car (trans tmp 1 0)))
    (progn
      (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0)))
      (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight)
      (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr))
    )
    (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft)
  )
  (vla-update nw_obj)
)
(vl-load-com)
(defun c:movetxt2leader ( / js htx AcDoc Space ent pt ss dxf_ent txt lay)
  (princ "\nSelect polyline.")
  (while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive text size <" (rtos (getvar "TEXTSIZE")) ">: ")))
  (if htx (setvar "TEXTSIZE" htx))
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (vla-startundomark AcDoc)
  (setq ent (ssname js 0) pr -1)
  (redraw ent 3)
  (repeat (fix (vlax-curve-getEndParam ent))
    (setq
      pt (vlax-curve-GetPointAtParam ent (setq pr (1+ pr)))
      ss
      (ssget
        "_C"
        pt
        (mapcar '+ pt (list (getvar "PDSIZE") (getvar "PDSIZE") (getvar "PDSIZE")))
        '((0 . "TEXT"))
      )
    )
    (cond
      (ss
        (setq
          dxf_ent (entget (ssname ss 0))
          txt (cdr (assoc 1 dxf_ent))
          lay (cdr (assoc 8 dxf_ent))
        )
        (make_mlead pt txt lay)
        (entdel (ssname ss 0))
      )
    )
  )
  (redraw ent 4)
  (vla-regen AcDoc acactiveviewport)
  (vla-endundomark AcDoc)
  (prin1)
)

 

Edited by Tsuky
Update for ask : request this code accepts only text on ID layer
  • Like 1
  • Replies 27
  • Created
  • Last Reply

Top Posters In This Topic

  • CADWORKER

    12

  • mhupp

    6

  • Steven P

    3

  • Tsuky

    3

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

mhupp
mhupp

Wasn't going that complicated. using the polyline vertex to pick the closet text to keep in some what of an order. rather then jumping all around. You could use grread to display text as your moving i

BIGAL
BIGAL

Well done Mhupp as suggested joins to insertion point. Thinking more do a bounding box then compare distance to say the 4 corners the smallest distance is the one to be used, add 4 more mid points wou

CADWORKER
CADWORKER

Thanks for your response, I have the following error.

Posted Images

CADWORKER Enthusiast

CADWORKER

Posted
  • Author
Posted
On 8/13/2023 at 12:41 PM, Tsuky said:

Hi

You can try this for move text to mleader

  

(vl-load-com)
(defun make_mlead (pt str / tmp ptlst arr nw_obj)
  (initget 9)
  (setq
    tmp (getpoint (trans pt 0 1) "\nLeader position: ")
    ptlst (append pt (polar pt (angle pt (trans tmp 1 0)) (distance pt (trans tmp 1 0))))
    arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
  )
  (vlax-safearray-fill arr ptlst)
  (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
  (vla-put-contenttype nw_obj acMTextContent)
  (vla-put-textstring nw_obj str)
  (vla-put-layer nw_obj "ID")
  (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
  (vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
  (if (> (car pt) (car (trans tmp 1 0)))
    (progn
      (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0)))
      (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight)
      (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr))
    )
    (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft)
  )
  (vla-update nw_obj)
)
(vl-load-com)
(defun c:movetxt2leader ( / js htx AcDoc Space ent pt ss txt)
  (princ "\nSelect polyline.")
  (while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive text size <" (rtos (getvar "TEXTSIZE")) ">: ")))
  (if htx (setvar "TEXTSIZE" htx))
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (vla-startundomark AcDoc)
  (setq ent (ssname js 0) pr -1)
  (redraw ent 3)
  (repeat (fix (vlax-curve-getEndParam ent))
    (setq
      pt (vlax-curve-GetPointAtParam ent (setq pr (1+ pr)))
      ss
      (ssget
        "_C"
        pt
        (mapcar '+ pt (list (getvar "PDSIZE") (getvar "PDSIZE") (getvar "PDSIZE")))
        '((0 . "TEXT") (8 . "ID"))
      )
    )
    (cond
      (ss
        (setq txt (cdr (assoc 1 (entget (ssname ss 0)))))
        (make_mlead pt txt)
        (entdel (ssname ss 0))
      )
    )
  )
  (redraw ent 4)
  (vla-regen AcDoc acactiveviewport)
  (vla-endundomark AcDoc)
  (prin1)
)

 

Thanks a lot this is what I need. Also, a small request this code accepts only text on ID layer what if the objects are on multiple layers and I need the arrow on the same layer as the text. This is a request.

Tsuky Community Regular

Tsuky

Posted
Posted
3 hours ago, CADWORKER said:

Also, a small request this code accepts only text on ID layer what if the objects are on multiple layers and I need the arrow on the same layer as the text

I have edited the previous code for your request

CADWORKER Enthusiast

CADWORKER

Posted
  • Author
Posted (edited)
22 hours ago, Tsuky said:

I have edited the previous code for your request

THANKS A LOT

Edited by CADWORKER
CADWORKER Enthusiast

CADWORKER

Posted
  • Author
Posted
22 hours ago, Tsuky said:

I have edited the previous code for your request

THANKS A LOT; is there any way to select the text which has to be relocated instead of all the texts on that line.

Tsuky Community Regular

Tsuky

Posted
Posted
On 8/16/2023 at 9:36 AM, CADWORKER said:

THANKS A LOT; is there any way to select the text which has to be relocated instead of all the texts on that line.

With a question for each? 

(vl-load-com)
(defun make_mlead (pt str lay / tmp ptlst arr nw_obj)
	(initget 9)
	(setq
		tmp (getpoint (trans pt 0 1) "\nLeader position: ")
		ptlst (append pt (polar pt (angle pt (trans tmp 1 0)) (distance pt (trans tmp 1 0))))
		arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
	)
	(vlax-safearray-fill arr ptlst)
	(setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
	(vla-put-contenttype nw_obj acMTextContent)
	(vla-put-textstring nw_obj str)
	(vla-put-layer nw_obj lay)
	(vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
	(vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
	(if (> (car pt) (car (trans tmp 1 0)))
		(progn
			(vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0)))
			(vla-put-TextJustify nw_obj acAttachmentPointMiddleRight)
			(vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr))
		)
		(vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft)
	)
	(vla-update nw_obj)
)
(vl-load-com)
(defun c:movetxt2leader ( / js htx AcDoc Space ent pt ss dxf_ent txt lay)
	(princ "\nSelect polyline.")
	(while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
	(initget 6)
	(setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive text size <" (rtos (getvar "TEXTSIZE")) ">: ")))
	(if htx (setvar "TEXTSIZE" htx))
	(setq
		AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
		Space
		(if (= 1 (getvar "CVPORT"))
			(vla-get-PaperSpace AcDoc)
			(vla-get-ModelSpace AcDoc)
		)
	)
	(vla-startundomark AcDoc)
	(setq ent (ssname js 0) pr -1)
	(repeat (fix (vlax-curve-getEndParam ent))
		(setq
			pt (vlax-curve-GetPointAtParam ent (setq pr (1+ pr)))
			ss
			(ssget
				"_C"
				pt
				(mapcar '+ pt (list (getvar "PDSIZE") (getvar "PDSIZE") (getvar "PDSIZE")))
				'((0 . "TEXT"))
			)
		)
		(cond
			(ss
				(setq
					dxf_ent (entget (ssname ss 0))
					txt (cdr (assoc 1 dxf_ent))
					lay (cdr (assoc 8 dxf_ent))
				)
				(redraw (cdar dxf_ent) 3)
				(initget "Yes No")
				(if (eq (getkword "\nProcess? [Yes/No] <N>: ") "Yes")
					(progn (make_mlead pt txt lay) (redraw (cdar dxf_ent) 4) (entdel (ssname ss 0)))
					(redraw (cdar dxf_ent) 4)
				)
			)
		)
	)
	(vla-regen AcDoc acactiveviewport)
	(vla-endundomark AcDoc)
	(prin1)
)

 

CADWORKER Enthusiast

CADWORKER

Posted
  • Author
Posted
2 hours ago, Tsuky said:

With a question for each? 

(vl-load-com)
(defun make_mlead (pt str lay / tmp ptlst arr nw_obj)
	(initget 9)
	(setq
		tmp (getpoint (trans pt 0 1) "\nLeader position: ")
		ptlst (append pt (polar pt (angle pt (trans tmp 1 0)) (distance pt (trans tmp 1 0))))
		arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
	)
	(vlax-safearray-fill arr ptlst)
	(setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
	(vla-put-contenttype nw_obj acMTextContent)
	(vla-put-textstring nw_obj str)
	(vla-put-layer nw_obj lay)
	(vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
	(vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
	(if (> (car pt) (car (trans tmp 1 0)))
		(progn
			(vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0)))
			(vla-put-TextJustify nw_obj acAttachmentPointMiddleRight)
			(vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr))
		)
		(vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft)
	)
	(vla-update nw_obj)
)
(vl-load-com)
(defun c:movetxt2leader ( / js htx AcDoc Space ent pt ss dxf_ent txt lay)
	(princ "\nSelect polyline.")
	(while (not (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
	(initget 6)
	(setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive text size <" (rtos (getvar "TEXTSIZE")) ">: ")))
	(if htx (setvar "TEXTSIZE" htx))
	(setq
		AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
		Space
		(if (= 1 (getvar "CVPORT"))
			(vla-get-PaperSpace AcDoc)
			(vla-get-ModelSpace AcDoc)
		)
	)
	(vla-startundomark AcDoc)
	(setq ent (ssname js 0) pr -1)
	(repeat (fix (vlax-curve-getEndParam ent))
		(setq
			pt (vlax-curve-GetPointAtParam ent (setq pr (1+ pr)))
			ss
			(ssget
				"_C"
				pt
				(mapcar '+ pt (list (getvar "PDSIZE") (getvar "PDSIZE") (getvar "PDSIZE")))
				'((0 . "TEXT"))
			)
		)
		(cond
			(ss
				(setq
					dxf_ent (entget (ssname ss 0))
					txt (cdr (assoc 1 dxf_ent))
					lay (cdr (assoc 8 dxf_ent))
				)
				(redraw (cdar dxf_ent) 3)
				(initget "Yes No")
				(if (eq (getkword "\nProcess? [Yes/No] <N>: ") "Yes")
					(progn (make_mlead pt txt lay) (redraw (cdar dxf_ent) 4) (entdel (ssname ss 0)))
					(redraw (cdar dxf_ent) 4)
				)
			)
		)
	)
	(vla-regen AcDoc acactiveviewport)
	(vla-endundomark AcDoc)
	(prin1)
)

 

yes, this is good and it is very much appreciated. Thank you. Intially my idea was to select the line and select a text and move to a new location with arrow and size change then select another. Anyways this is also good.

CADWORKER Enthusiast

CADWORKER

Posted
  • Author
Posted

Hi, 

I have made a code that is not perfect. what I does it move the text and draws an arrow from the text insertion point.

I need in this code is to

change the text height,

set the arrow to the layer of the text and an option for arrow size.

continuous selections of text after each relocation.

 

(Defun c:Tpx (/ IP IP2) 
(setq txt (car (entsel "Pick Text"))); entity
(if txt
(progn
(setq elist (entget txt)); entity list
(setq IP (cdr (assoc 10 elist))); Insertion Point
); progn
); if
(setq IP2 (getpoint "\nPick Next point: "))
(command "move" txt "" ip IP2 "")
(command "_.leader" IP IP2 "_a" "" "_n"))

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  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.

×
 Share
Go to topic listing
×
×
  • Create New...