LISP to create lines between basepoints of multiple selected objects

LISP to create lines between basepoints of multiple selected objects

mbk.ee11
Explorer Explorer
309 Views
3 Replies
Message 1 of 4

LISP to create lines between basepoints of multiple selected objects

mbk.ee11
Explorer
Explorer

Is there any existing lisp routine or a method to create/place lines between basepoints of multiple selected objects? See attached drawing for what exactly I'm looking for. Any help, much appreciated. Thanks in advance!!! 

0 Likes
Accepted solutions (1)
310 Views
3 Replies
Replies (3)
Message 2 of 4

Kent1Cooper
Consultant
Consultant

Put something like "connect blocks" in the Search window -- there is probably something among the findings that will do what you want.

Kent Cooper, AIA
0 Likes
Message 3 of 4

Moshe-A
Mentor
Mentor
Accepted solution

@mbk.ee11  hi,

 

check PCHAIN command.

 

the best suit for selection is WP (window polygon)

 

enjoy

Moshe

 

 

 

(vl-load-com)

(defun c:pchain (/ get_points _sortby draw_pline ; local functions
		  ss points^ xdir^ ydir^)

 (defun get_points ()
  (mapcar
    (function
      (lambda (ename)
       (cdr (assoc '10 (entget ename))) 
      ); lambda
    ); function
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  ); mapcar
 ); get_points

  
 (setq _sortby (lambda (f l) (vl-sort l (function (lambda (e0 e1) (< (f e0) (f e1))))))) 

  
 (defun draw_pline (lst / pt)
  (command "._line")
  (foreach pt lst
   (command "_none" pt)
  )
  (command "")
 ); draw_pline
  

 ; here start c:pchain
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")
  
 (if (setq ss (ssget '((0 . "insert"))))
  (progn
   (setq points^ (get_points))
   (setq xdir^ (_sortby car  points^))
   (setq ydir^ (_sortby cadr points^))

   (if (> (distance (car xdir^) (car (reverse xdir^))) (distance (car ydir^) (car (reverse ydir^))))
    (draw_pline xdir^)     
    (draw_pline ydir^)
   ); if
   
  ); progn
 ); if

 (command "_undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ)
); c:pchain
  

 

 

0 Likes
Message 4 of 4

mbk.ee11
Explorer
Explorer

Thank you so much @Moshe-A . It works very well. 

0 Likes