Automatic Draw Polyline From Block To Text/Mtext at Once

[zams23]

Need lisp for this case 

 

Before

 

After

[hosneyalaa]

maybe Support what you want With an example of a drawing complete

[BIGAL]

Maybe this a quick and dirty

(defun c:wow ( / ss blk inspt inspt2)
(setq blk (entsel "\npick block "))
(setq inspt (cdr (assoc 10 (entget (car blk)))))
(prompt "Select text ")
(setq ss (ssget '((0 . "*TEXT"))))
(if (= ss nil)
 (alert "No plain Text selected ")
 (repeat (setq x (sslength ss))
  (setq ent (ssname ss (setq x (1- x))))
  (setq inspt2 (cdr (assoc 10 (entget ent))))
  (command "line" inspt inspt2 "")
 )
)
(princ)
)

 

Edited October 3, 2023 by BIGAL

[zams23]

I have tried with the lisp that you have provided, the results still do not change. 

 

[zams23]

On 9/30/2023 at 11:28 AM, hosneyalaa said:

maybe Support what you want With an example of a drawing complete

I want to create lines or polylines at once, from the same object to different destinations

[BIGAL]

Did you pick a block, then Mtext text etc without a dwg to test not sure what is happening.

[zams23]

17 hours ago, BIGAL said:

Did you pick a block, then Mtext text etc without a dwg to test not sure what is happening.

I have followed the command prompt instructions, and the result is that nothing happens

[BIGAL]

Not sure what is wrong, before after

 

Maybe something to do with your block post a sample dwg.

[zams23]

5 hours ago, BIGAL said:

Not sure what is wrong, before after

 

Maybe something to do with your block post a sample dwg.

Edited October 2, 2023 by zams23
it's solved

[zams23]

5 hours ago, BIGAL said:

Not sure what is wrong, before after

 

Maybe something to do with your block post a sample dwg.

You are so amazing. thank you for helping me. its work 

[zams23]

On 10/1/2023 at 11:28 AM, BIGAL said:

Maybe this a quick and dirty

(defun c:wow ( / ss blk inspt inspt2)
(setq blk (entsel "\npick block "))
(prompt "Select text ")
(setq inspt (cdr (assoc 10 (entget (car blk)))))
(setq ss (ssget '((0 . "*TEXT"))))
(if (= ss nil)
(alert "No plain Text selected ")
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (1- x))))
(setq inspt2 (cdr (assoc 10 (entget ent))))
(command "line" inspt inspt2 "")
)
)
(princ)
)

 

if i want to change from block to all object, how to change the lisp. 

[BIGAL]

You could just pick a point.

; (setq blk (entsel "\npick block "))
(setq inspt (getpoint "\nPick point for end of lines. "))

 

[exceed]

; 1L - 2023.10.05 exceeds
; draw lines from selected objects to 1 point.

(defun c:1L (/ *error* acdoc ss ssl pt1 index ent pt2 line) 
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (defun *error* (msg) 
    (vla-endundomark acdoc)
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") 
        (princ (strcat "\n** Error: " msg " **"))
    )
    (princ)
  )
  (vla-endundomark acdoc)
  (vla-startundomark acdoc)
  
  (princ "\n Select Objects to draw line : ")
  (setq ss (ssget))
  (setq ssl (sslength ss))
  (princ "\n Pick origin point : ")
  (setq pt1 (getpoint))
  (princ pt1)
  (setq index 0)
  (repeat ssl 
    (setq ent (ssname ss index))
    (setq pt2 (cdr (assoc 10 (entget ent))))
    (setq line (entmakex 
                 (list (cons 0 "LINE") 
                       (cons 10 (list (car pt1) (cadr pt1) 0.0))
                       (cons 11 (list (car pt2) (cadr pt2) 0.0))
                 )
               )
    )
    (setq index (+ index 1))
  )
  (vla-endundomark acdoc)
  (princ)
)

 

This is what I use.

It can be used with manual selection set,

but it is also good for remembering the selection set

after [Find > SelectAll] or [QSELECT] something.