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

[CADWORKER]

Dear All,

I have a situation where  I have to scale the text and move it to avoid overlaps, the show an arrow to  its original position.

All I am looking for is a code that will do the following.

1. SELECT THE TEXT.
2. THE HEIGHT SHOULD CHANGE TO 2.0.
3. SHOULD MOVE THE TEXT TO A NEW LOCATION.
4. START AN ARROW FROM THE TEXT FIRST LOCATION TO NEW LOCATION.
5. ARROW SHOULD BE IN THE SAME LAYER AS THE SELECTED TEXT.

 

THANKYOU ALL 

AFTER.dwg BEFORE.dwg

[mhupp]

This has been asked for several times over the years. no real automatic way to do this. Tho could possibly speed it up with manual input from the user. let me think on it.

 

[BIGAL]

A simple answer is pick text, move text, pick X, draw a leader, connecting X to the insertion point. The complicated part is having the leader say come from another quadrant point of the Text. Can be done using a bounding box for correct corner. Sorry busy at moment, Mhupp may help.

Look at 2060

Edited August 2, 2023 by BIGAL

[mhupp]

On 8/2/2023 at 7:55 PM, BIGAL said:

The complicated part is having the leader say come from another quadrant point of the Text. Can be done using a bounding box for correct corner. Sorry busy at moment, Mhupp may help.

 

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 it. This is more a proof of concept. anyone else feel free to make changes.

 

(defun C:TxtMov (/ mspace ss ssP cords size base LL UR pt2)
  (vl-load-com)
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq mspace (vla-get-ModelSpace doc))
  (prompt "\nSelect Polyline to Follow")
  (setq ssP (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
  (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ssP 0)))))
  (setq size (getreal "\nText Size: "))
  (prompt "\nSelect Text")
  (while (setq ss (ssget '((0 . "TEXT"))))
    (foreach pt cords
      (foreach txt (mapcar 'vlax-Ename->Vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
        (if (and (setq base (vlax-get txt 'InsertionPoint)) (< (distance pt base) 0.05))
          (progn
            (vla-put-height txt size)
            (command "_.Move" (vlax-vla-object->ename txt) "" "_NONE" pt pause)
            (vla-getboundingbox txt 'minpt 'maxpt)
            (setq LL (vlax-safearray->list minpt)
                  UR (vlax-safearray->list maxpt)
            )
            (command "_.Rectangle" "_non" LL "_non" UR)
            (setq pt2 (vlax-curve-getClosestPointTo (entlast) pt))
            (entdel (entlast))
            (vla-addline mspace (vlax-3d-point pt) (vlax-3d-point pt2)) ;needed (vlax-3d-point 
            (ssdel (vlax-vla-object->ename txt) ss) 
          )
        )
      )
    )
    (prompt "\nSelect Text")
  )
  (vla-endundomark doc)
  (princ)
)

 

 

 

 

 

Edited August 10, 2023 by mhupp
updated code

[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 would be even better.

[mhupp]

Yeah changing the size of text then issuing move command would allow you to see where the text would end up

Create bounding box for text

feed that into vlax-curve-getClosestPointTo to get a more  dynamic location for pt2

(setq pt2 (vlax-curve-getClosestPointTo Bounndingbox pt))

delete bounding box.

draw leader/line

 

[CADWORKER]

5 hours ago, mhupp said:

 

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 it. This is more a proof of concept. anyone else feel free to make changes.

 

(defun C:MOVTXT (/ ss ssP cords pt2)
  (vl-load-com)
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq mspace (vla-get-ModelSpace doc))
  (prompt "\nSelect Text")
  (setq ss (ssget '((0 . "TEXT"))))
  (prompt "\nSelect Polyline to Follow")
  (setq ssP (ssget "_+.:E:S" '(("LWPOLYLINE"))))
  (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ssP 0)))))
  (setq size (getreal "\nText Size: "))
  (foreach pt cords
    (foreach txt (mapcar 'vlax-Ename->Vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (if (and (setq base (vlax-get txt 'InsertionPoint)) (< (distance pt base) 0.05))
        (progn
          (setq pt2 (getpoint pt))
          (vla-put-insertionpoint txt pt2)
          (vla-put-height txt size)
          (vla-addline mspace (vlax-3d-point pt) (vlax-3d-point pt2))
          (ssdel (vlax-vla-object->ename txt) ss)
        )
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

 

 

 

Thanks for this wonderful code, is there any way to select the text one at a time and do this. Not all the text to be increased and relocated, this all depend on the density of the points.

Thanks once again

[mhupp]

It already worked that way just Select the text you want to move. Then the polyline they are attached to.

 

--Edit

I update the code to give a better preview of the text location and leader placement. and allows multiple selections. will only ask to select the polyline and text size one per command.

 

Edited August 4, 2023 by mhupp

[CADWORKER]

 I am getting this error message

Command: TXTMOV
Select Polyline to Follow; error: bad SSGET list
Command:

[Steven P]

The error says ssget so look at the ssget lines in the code and see if you can spot it?

 

Could be this line

(setq ssP (ssget "_+.:E:S" '(( "LWPOLYLINE"))))

 

and then you can work out how to fix it?

[CADWORKER]

On 8/5/2023 at 11:27 AM, Steven P said:

The error says ssget so look at the ssget lines in the code and see if you can spot it?

 

Could be this line

(setq ssP (ssget "_+.:E:S" '(( "LWPOLYLINE"))))

 

and then you can work out how to fix it?

I tried a couple of ways but no success.

[Steven P]

Think it is just a typo in the code, did you try:

 

(setq ssP (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))

 

It was missing the "0 .", got to tell the ssget what to filter on

 

 

Note I haven't tested this to see where any problems might be but suspect will just be this

Edited August 7, 2023 by Steven P

[CADWORKER]

19 minutes ago, Steven P said:

Think it is just a typo in the code, did you try:

 

(setq ssP (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))

 

It was missing the "0 .", got to tell the ssget what to filter on

 

 

Note I haven't tested this to see where any problems might be but suspect will just be this

Thanks for your response, I have the following error.

[mhupp]

My bad that's what i get for working in notepad!

As far as the error might have to tweak the move or rectangle command lines.

This is why I don't like using command different software have different inputs.

might need an extra "" after the pause in the move but IDK its working for me in BricsCAD.

Edited August 8, 2023 by mhupp

[Steven P]

I make all my best mistakes in notepad

[CADWORKER]

On 8/7/2023 at 11:59 PM, mhupp said:

My bad that's what i get for working in notepad!

As far as the error might have to tweak the move or rectangle command lines.

This is why I don't like using command different software have different inputs.

might need an extra "" after the pause in the move but IDK its working for me in BricsCAD.

Command: TXTMOV

Select Polyline to Follow

Select objects:

Text Size: 2

Select Text

Select objects: Regenerating model.

1 found

Select objects: 1 found, 2 total

Select objects: 1 found, 3 total

Select objects: 1 found, 4 total

Select objects: 1 found, 5 total

Select objects:  _.Move

Select objects:   1 found

Select objects:

Specify base point or [Displacement] <Displacement>: _NONE

Specify second point or <use first point as displacement>:

Command: _.Rectangle

Specify first corner point or [Chamfer/Elevation/Fillet/Thickness/Width]: _non

Specify other corner point or [Area/Dimensions/Rotation]: _non

Command: ; error: lisp value has no coercion to VARIANT with this type:  (16.2563 4.2643)

 

 

Thanks for your help. Still has some errors to solve

Edited August 10, 2023 by CADWORKER

[mhupp]

Someone with AutoCAD is going to have to trouble shoot it because its working on this end in BricsCAD.

 

--Edit

Scratch that apparently you need to hold AutoCAD's hand and wrap the points with (vlax-3d-point for it to work with vla-addline. ref here

 

You don't have to do that in BricsCAD. updated lisp should work now.

Edited August 10, 2023 by mhupp
Updated Code

[SLW210]

I get (; error: bad argument type: lselsetp nil) on the command line in AutoCAD 2022.

 

Command: TXTMOV

Select Polyline to Follow
Select objects:
; error: bad argument type: lselsetp nil

 

[SLW210]

I get this as break source

 

(ssname ssP 0)

 

[CADWORKER]

On 8/11/2023 at 2:37 PM, SLW210 said:

I get this as break source

 

(ssname ssP 0)

 

Hi, I Removed (ssname ssP 0) and I get this error.

Command: TXTMOV
Select Polyline to Follow
Select objects:
; error: too few arguments
Command: