Lisp that create line

[Tolearnlisp]

Hi fellows, 

would like to have a lisp that create automatic line from center of a square to the center of a circle respectively just by selecting the square and circle after the Lisp command. Thanks in advance.

 

[dbhunia]

@ВeekeeCZ thanks to point out the mistake, Here is the modified one......

(defun c:csl ( / ss ss_c ss_r lst p1 p2 MP NL N C_lst S_lst Ans)

(defun Poly_Cor_Extr (key cor / val cor_list)
   (foreach val cor
	(if (eq key (car val)) (setq cor_list (cons (cdr val) cor_list)))
   )
(reverse cor_list)
)
(initget "Horizontal Vertical Angular")
(setq Ans (cond ((getkword "\nCircles & Squares Position is [Horizontal/Vertical/Angular] <Horizontal>: ")) ("Horizontal")))
(prompt "\nSelect Circles.......")
(setq ss_c (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "CIRCLE")))))))
    (foreach item ss_c
	(setq C_lst (cons (cdr (assoc 10 (entget item))) C_lst))
    )
(if (/= "Vertical" Ans)
    (setq C_lst (vl-sort C_lst '(lambda (e1 e2) (< (car e1) (car e2)))))
    (setq C_lst (vl-sort C_lst '(lambda (e1 e2) (< (cadr e1) (cadr e2)))))
)
(prompt "\nSelect Squares.......")
(setq ss_r (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE")(90 . 4)))))))
    (foreach item ss_r
   	(setq lst (Poly_Cor_Extr 10 (entget item)))
	(setq p1 (nth 0 lst) p2 (nth 2 lst))
	(setq MP (polar p1 (angle p1 p2) (/ (distance p1 p2) 2)))
	(setq S_lst (cons MP S_lst))
    )
(if (/= "Vertical" Ans)
    (setq S_lst (vl-sort S_lst '(lambda (e1 e2) (< (car e1) (car e2)))))
    (setq S_lst (vl-sort S_lst '(lambda (e1 e2) (< (cadr e1) (cadr e2)))))
)
(if (< (length S_lst) (length C_lst)) (setq NL (length S_lst)) (setq NL (length C_lst)))
(setq N -1)
(repeat NL
    (entmake (list '(0 . "LINE") (cons 8 (getvar 'clayer)) (cons 10 (nth (setq N (1+ N)) C_lst)) (cons 11 (nth N S_lst))))
)
(princ)
)

[Tolearnlisp]

Hi BeeKeeCZ,

Thank you for effort in generating this LISP. I had done the testing and it works pretty good.

I was thinking of additional routine to be merged to this current LISP like creating line from the center of the square to the center of an Arc, Center of the square to the plotted points/nodes, center of the square to the midpoint of a line.

I hope that this idea of mine is feasible.

I have attached the drawing for your reference.

[ВeekeeCZ · Accepted solution]

OK, the first 4 combined. The offset-one would be dedicated, later.

(defun c:LineConnect (/ ss ssp ssc lsp lsc d d0 dir)
  
  (if (and (princ "\nSelect SQUAREs and other end to connect: ")
	   (setq ss (ssget '((-4 . "<OR")
			     (0 . "CIRCLE,ARC,LINE,POINT")
			     (-4 . "<AND") (0 . "LWPOLYLINE") (90 . 4) (-4 . "AND>")
			     (-4 . "OR>"))))
	   (setq ssp (acet-ss-ssget-filter ss '((0 . "LWPOLYLINE"))))
	   (setq ssc (acet-ss-ssget-filter ss '((0 . "~LWPOLYLINE"))))
	   (setq lsp (mapcar '(lambda (e) (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget e))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssp)))))
	   (setq lsp (mapcar '(lambda (x) (mapcar '/ (mapcar '+ (cdar x) (cdaddr x)) '(2 2))) lsp))
	   (setq lsc (mapcar '(lambda (e / ed) (if (= "LINE" (cdr (assoc 0 (setq ed (entget e)))))
						 (mapcar '/ (mapcar '+ (cdr (assoc 10 ed)) (cdr (assoc 11 ed))) '(2 2))
						 (cdr (assoc 10 ed))))
			     (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssc)))))
	   (setq d (abs (/ (-  (apply 'max (mapcar 'car lsp)) (apply 'min (mapcar 'car lsp)))      			;xmax-xmin
			   (if (zerop (setq d0 (- (apply 'max (mapcar 'cadr lsp)) (apply 'min (mapcar 'cadr lsp))))) 	;ymax-ymin
			     0.001
			     d0))))
	   )
    (progn
      (if (< 0.2 d 5)
	(progn
	  (initget "Horizontal Vertical")
	  (setq dir (getkword "\nChoose an option [Horizontal/Vertical]: "))))
      (if (or (= dir "Horizontal")
	      (> d 5))
	(setq lsp (vl-sort lsp '(lambda (p q) (< (car  p) (car  q))))
	      lsc (vl-sort lsc '(lambda (p q) (< (car  p) (car  q)))))
	(setq lsp (vl-sort lsp '(lambda (p q) (< (cadr p) (cadr q))))
	      lsc (vl-sort lsc '(lambda (p q) (< (cadr p) (cadr q))))))
      (mapcar '(lambda (p1 p2)
		 (entmakex (list (cons 0 "LINE")
				 (cons 10 p1)
				 (cons 11 p2)
				 (cons 8 "wire"))))
	      lsc
	      lsp)))
  (princ)
  )

[Tolearnlisp]

Hi BeeKeeCZ and Team,

I appreciate your past response. I tried this code and it works perpectly. Looking forward for the same support later on with different topics. Thank you.

[ВeekeeCZ · Accepted solution]

---

@ВeekeeCZ wrote:

OK, the first 4 combined. The offset-one would be dedicated, later.

Well, here is the offset-one. This one is well-made enough to cover all 5 cases. You just set offset to 0 for cases 1-4.

Accually there are 2 routines

- LineConnectOff - main routine, when it's run for 1st time it will call the LineConnestOffSet for initial offset setting.

- LineConnectOffSet - just helper routine to re-set the offset. You need this for changing the offset distance.

- You can also adjust the default setting different then 0.1.

(defun c:LineConnectOffSet (/ ss ssp ssc lsp lsc d d0 dir)

  (or *lco-off*
      (setq *lco-off* 0.1)) 		; <---  default offset
  
  (setq *lco-off* (cond ((getdist (strcat "\nSet offset <" (rtos *lco-off* 2 2) ">: ")))
			(*lco-off*))))



; --------------------------------------------------------------------------------------------------------

(defun c:LineConnectOff (/ ss ssp ssc lsp lsc d d0 dir)
  
  (or *lco-off*
      (c:LineConnectOffSet))  
  
  (if (and (princ "\nSelect SQUAREs and other entities to connect: ")
	   (setq ss (ssget '((-4 . "<OR")
			     (0 . "CIRCLE,ARC,LINE,POINT")
			     (-4 . "<AND") (0 . "LWPOLYLINE") (90 . 4) (-4 . "AND>")
			     (-4 . "OR>"))))
	   (setq ssp (acet-ss-ssget-filter ss '((0 . "LWPOLYLINE"))))
	   (setq ssc (acet-ss-ssget-filter ss '((0 . "~LWPOLYLINE"))))
	   (setq lsp (mapcar '(lambda (e) (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget e))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssp)))))
	   (setq lsp (mapcar '(lambda (x) (mapcar '/ (mapcar '+ (cdar x) (cdaddr x)) '(2 2))) lsp))
	   (setq lsc (mapcar '(lambda (e / ed) (if (= "LINE" (cdr (assoc 0 (setq ed (entget e)))))
						 (mapcar '/ (mapcar '+ (cdr (assoc 10 ed)) (cdr (assoc 11 ed))) '(2 2))
						 (cdr (assoc 10 ed))))
			     (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssc)))))
	   (setq d (abs (/ (-  (apply 'max (mapcar 'car lsp)) (apply 'min (mapcar 'car lsp)))      			;xmax-xmin
			   (if (zerop (setq d0 (- (apply 'max (mapcar 'cadr lsp)) (apply 'min (mapcar 'cadr lsp))))) 	;ymax-ymin
			     0.001
			     d0))))
	   )
    (progn
      (if (< 0.2 d 5)
	(progn
	  (initget "Horizontal Vertical")
	  (setq dir (getkword "\nChoose an option [Horizontal/Vertical]: "))))
      (if (or (= dir "Horizontal")
	      (> d 5))
	(setq lsp (vl-sort lsp '(lambda (p q) (< (car  p) (car  q))))
	      lsc (vl-sort lsc '(lambda (p q) (< (car  p) (car  q))))
	      lsc (mapcar '(lambda (x) (mapcar '+ x (list 0
							  ((if (minusp (- (/ (apply '+ (mapcar 'cadr lsp)) (length lsp))
									  (/ (apply '+ (mapcar 'cadr lsc)) (length lsc))))
							     + -) 0 *lco-off*))))
			  lsc))
	
	(setq lsp (vl-sort lsp '(lambda (p q) (< (cadr p) (cadr q))))
	      lsc (vl-sort lsc '(lambda (p q) (< (cadr p) (cadr q))))
	      lsc (mapcar '(lambda (x) (mapcar '+ x (list ((if (minusp (- (/ (apply '+ (mapcar 'car lsp)) (length lsp))
									  (/ (apply '+ (mapcar 'car lsc)) (length lsc))))
							     + -) 0 *lco-off*)
							  0)))
			  lsc)))
      (mapcar '(lambda (p1 p2)
		 (entmakex (list (cons 0 "LINE")
				 (cons 10 p1)
				 (cons 11 p2)
				 (cons 8 "wire"))))
	      lsc lsp)))
  (princ)
  )

[Tolearnlisp]

Hi BeekeeCZ,

1.

Thanks a Lot. I've found that at single selection on horizontal side, offset are horizontal but with group selection it works. On the other hand on vertical side, both single and group selection works pretty fine.

2.

I have additional thing as part of these LISP enhancement, I encountered other cases that sometimes the squares have radius (no fix value). I have attached the drawing below for your reference. Thanks in advance.

[ВeekeeCZ]

Hi, here is the last modification.

If just a single connection is in the process, it still will be trying to decide automatically whether it's horizontal or vertical. If the angle would be within the range 35-55°, you need to decide. Or you can use LineConnectOffManual where you need to decide all cases.

(defun c:LineConnectOff nil  (LineConnectOff nil))
(defun c:LineConnectOffManual nil (LineConnectOff T))

(defun c:LineConnectOffSet nil
  
  (or *lco-off*
      (setq *lco-off* 0.1)) 		; <---  default offset
  
  (setq *lco-off* (cond ((getdist (strcat "\nSet offset <" (rtos *lco-off* 2 2) ">: ")))
                        (*lco-off*))))
 

; --------------------------------------------------------------------------------------------------------

(defun LineConnectOff (m / ss ssp ssc lsp lsc d d0 dir a p)
  
  (or *lco-off*
      (c:LineConnectOffSet))
  
  (if (and (princ "\nSelect SQUAREs and other entities to connect: ")
           (setq ss (ssget '((-4 . "<OR")
                             (0 . "CIRCLE,ARC,LINE,POINT")
                             (-4 . "<AND") (0 . "LWPOLYLINE") (-4 . "&=") (70 . 1) (-4 . "AND>")
                             (-4 . "OR>"))))
           (setq ssp (acet-ss-ssget-filter ss '((0 . "LWPOLYLINE"))))
           (setq ssc (acet-ss-ssget-filter ss '((0 . "~LWPOLYLINE"))))
           (setq lsp (mapcar '(lambda (e)
                                (vla-getboundingbox (vlax-ename->vla-object e) 'minpt 'maxpt)
                                (mapcar '/ (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt)) '(2 2)))
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssp)))))
           (setq lsc (mapcar '(lambda (e / ed)
                                (if (= "LINE" (cdr (assoc 0 (setq ed (entget e)))))
                                  (mapcar '/ (mapcar '+ (cdr (assoc 10 ed)) (cdr (assoc 11 ed))) '(2 2))
                                  (cdr (assoc 10 ed))))
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssc)))))
           (setq d (abs (/ (-  (apply 'max (mapcar 'car lsp)) (apply 'min (mapcar 'car lsp)))      			;xmax-xmin
                           (if (zerop (setq d0 (- (apply 'max (mapcar 'cadr lsp)) (apply 'min (mapcar 'cadr lsp))))) 	;ymax-ymin
                             0.001
                             d0))))
           )
    (progn
      
      (if (= (length lsp) 1)
        (setq a (rem (angle (car lsp) (car lsc)) pi)))
      
      (while (not dir)
        
        (cond ((and (not m)
                    a
                    (< (* 55 (/ pi 180)) a (* 125 (/ pi 180))))
               (setq dir "Vertical"))
              
              ((and (not m)
                    a
                    (or (< a (* 35 (/ pi 180)))
                        (> a (* 145 (/ pi 180)))))
               (setq dir "Horizontal"))
              
              ((and (not m)
                    (not a)
                    (< d 0.2))
               (setq dir "Horizontal"))
              
              ((and (not m)
                    (not a)
                    (> d 5))
               (setq dir "Vertical"))
              
              (T
               (initget "Horizontal Vertical")
               (setq dir (cond ((if m
                                  (getkword "\nPick a direction [Vertical] <Horizontal>: ")
                                  (getpoint (setq p (nth (/ (length lsp) 2) lsp)) "\nPick a direction [Vertical] <Horizontal>: ")))
                               ("Horizontal")))
               (if (listp dir) (setq a (rem (angle p dir) pi)
                                     dir nil)))))
      
      (if (= dir "Vertical")
        (setq lsp (vl-sort lsp '(lambda (p q) (< (car  p) (car  q))))
              lsc (vl-sort lsc '(lambda (p q) (< (car  p) (car  q))))
              lsc (mapcar '(lambda (x) (mapcar '+ x (list 0
                                                          ((if (minusp (- (/ (apply '+ (mapcar 'cadr lsp)) (length lsp))
                                                                          (/ (apply '+ (mapcar 'cadr lsc)) (length lsc))))
                                                             + -) 0 *lco-off*))))
                          lsc))
        
        (setq lsp (vl-sort lsp '(lambda (p q) (< (cadr p) (cadr q))))
              lsc (vl-sort lsc '(lambda (p q) (< (cadr p) (cadr q))))
              lsc (mapcar '(lambda (x) (mapcar '+ x (list ((if (minusp (- (/ (apply '+ (mapcar 'car lsp)) (length lsp))
                                                                          (/ (apply '+ (mapcar 'car lsc)) (length lsc))))
                                                             + -) 0 *lco-off*)
                                                          0)))
                          lsc)))
      
      (mapcar '(lambda (p1 p2) (entmake (list (cons 0 "LINE")
                                              (cons 10 p1)
                                              (cons 11 p2)
                                              (cons 8 "wire"))))
              lsc lsp)))
  (princ)
  )

[Tolearnlisp]

Hi BeeKeeCZ,

Thanks a lot!

How about may question number 2 in the previous thread.

2.

I have additional thing as part of these LISP enhancement, I encountered other cases that sometimes the squares have radius (no fix value). I have attached the drawing below for your reference. Thanks in advance.

Suggestion: (the square's and square's with radius should be working whenever I choose of them.) Is it possible?

[ВeekeeCZ · Accepted solution]

Well, I didn't put any comment on that one, but I did cover that too. Did you test it?

Though, trying the code again, added one minor improvement.

(defun c:LineConnectOff nil  (LineConnectOff nil))
(defun c:LineConnectOffManual nil (LineConnectOff T))

(defun c:LineConnectOffSet nil
  
  (or *lco-off*
      (setq *lco-off* 0.1)) 		; <---  default offset
  
  (setq *lco-off* (cond ((getdist (strcat "\nSet offset <" (rtos *lco-off* 2 2) ">: ")))
                        (*lco-off*))))
 

; --------------------------------------------------------------------------------------------------------

(defun LineConnectOff (m / ss ssp ssc lsp lsc d d0 dir a p)
  
  (or *lco-off*
      (c:LineConnectOffSet))
  
  (if (and (princ "\nSelect SQUAREs and other entities to connect: ")
           (setq ss (ssget '((-4 . "<OR")
                             (0 . "CIRCLE,ARC,LINE,POINT")
                             (-4 . "<AND") (0 . "LWPOLYLINE") (-4 . "&=") (70 . 1) (-4 . "AND>")
                             (-4 . "OR>"))))
           (setq ssp (acet-ss-ssget-filter ss '((0 . "LWPOLYLINE"))))
           (setq ssc (acet-ss-ssget-filter ss '((0 . "~LWPOLYLINE"))))
           (setq lsp (mapcar '(lambda (e)
                                (vla-getboundingbox (vlax-ename->vla-object e) 'minpt 'maxpt)
                                (mapcar '/ (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt)) '(2 2)))
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssp)))))
           (setq lsc (mapcar '(lambda (e / ed)
                                (if (= "LINE" (cdr (assoc 0 (setq ed (entget e)))))
                                  (mapcar '/ (mapcar '+ (cdr (assoc 10 ed)) (cdr (assoc 11 ed))) '(2 2))
                                  (cdr (assoc 10 ed))))
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssc)))))
           (setq d (abs (/ (-  (apply 'max (mapcar 'car lsp)) (apply 'min (mapcar 'car lsp)))      			;xmax-xmin
                           (if (zerop (setq d0 (- (apply 'max (mapcar 'cadr lsp)) (apply 'min (mapcar 'cadr lsp))))) 	;ymax-ymin
                             0.001
                             d0))))
           )
    (progn
      
      (if (= (length lsp) 1)
        (setq a (rem (angle (car lsp) (car lsc)) pi)))
      
      (while (not dir)
        
        (cond ((and a
                    (zerop *lco-off*))
               (setq dir "Vertical"))
               
              ((and (not m)
                    a
                    (< (* 55 (/ pi 180)) a (* 125 (/ pi 180))))
               (setq dir "Vertical"))
              
              ((and (not m)
                    a
                    (or (< a (* 35 (/ pi 180)))
                        (> a (* 145 (/ pi 180)))))
               (setq dir "Horizontal"))
              
              ((and (not m)
                    (not a)
                    (< d 0.2))
               (setq dir "Horizontal"))
              
              ((and (not m)
                    (not a)
                    (> d 5))
               (setq dir "Vertical"))
              
              (T
               (initget "Horizontal Vertical")
               (setq dir (cond ((if m
                                  (getkword "\nPick a direction [Vertical] <Horizontal>: ")
                                  (getpoint (setq p (nth (/ (length lsp) 2) lsp)) "\nPick a direction [Vertical] <Horizontal>: ")))
                               ("Horizontal")))
               (if (listp dir) (setq a (rem (angle p dir) pi)
                                     dir nil)))))
      
      (if (= dir "Vertical")
        (setq lsp (vl-sort lsp '(lambda (p q) (< (car  p) (car  q))))
              lsc (vl-sort lsc '(lambda (p q) (< (car  p) (car  q))))
              lsc (mapcar '(lambda (x) (mapcar '+ x (list 0
                                                          ((if (minusp (- (/ (apply '+ (mapcar 'cadr lsp)) (length lsp))
                                                                          (/ (apply '+ (mapcar 'cadr lsc)) (length lsc))))
                                                             + -) 0 *lco-off*))))
                          lsc))
        
        (setq lsp (vl-sort lsp '(lambda (p q) (< (cadr p) (cadr q))))
              lsc (vl-sort lsc '(lambda (p q) (< (cadr p) (cadr q))))
              lsc (mapcar '(lambda (x) (mapcar '+ x (list ((if (minusp (- (/ (apply '+ (mapcar 'car lsp)) (length lsp))
                                                                          (/ (apply '+ (mapcar 'car lsc)) (length lsc))))
                                                             + -) 0 *lco-off*)
                                                          0)))
                          lsc)))
      
      (mapcar '(lambda (p1 p2) (entmake (list (cons 0 "LINE")
                                              (cons 10 p1)
                                              (cons 11 p2)
                                              (cons 8 "wire"))))
              lsc lsp)))
  (princ)
  )

[Tolearnlisp]

Hi BeeKeeCZ,

Thank you for your effort in making this possible.

I tried tested this routine and it works perfectly as what I am expecting.