how to connect line automatically all block to use this lisp?

[Anonymous]

hi everyone, 

i attached here lips that lisp I using now. my problem is it does not connect all block with a line . when i use this lisp only just doing insert block after nothing happened(not connect line for all block). I don't know why can't connect the line.

i pretty sure that lisp has some mistake but i don't know how to resolve it.

i want that lisp to do all itself.i hope you to understand everything. I attached here a block and image for reference.

i appreciate your help.

(DEFUN c:t4 (/ sc clay)
  (setvar "cmdecho" 0)
  (vl-load-com)

  (setq    util (vla-get-utility
           (vla-get-activedocument
         (vlax-get-acad-object)
           )
         )
  )
  (setq    Pt1
     (getpoint "\nPick First Point")
  )                    ;PROMPT FOR FIRST POINT
  (setq    Pt2
     (getpoint "\nPick Second Point")
  )
;(princ "\nPt1=")
;  (princ Pt1)
;(princ "\nPt2=")
 ; (princ Pt2)
(setq os (getvar 'osmode))
(setvar 'osmode 0)
;;; you codes here ...

  
  (setq    drows (vla-GetReal
        util
        "\nEnter the distance between rows (---): "
          )
  )
  (setq    dcols (vla-GetReal
        util
        "Specify the distance between columns (|||): "
          )
  )
         
  (setq X1 (car Pt1))
  (setq Y1 (car (cdr Pt1)))
  (setq X2 (car Pt2))
  (setq Y2 (car (cdr Pt2)))
                    
  (setq X (abs (- X1 X2)))
  (setq Y (abs (- Y1 Y2)))

 
  (setq ncols (+ 1 (/ (- X (rem X dcols)) dcols)))

  (setq nrows (+ 1 (/ (- Y (rem Y drows)) drows)))

 
  (setq modx (/ (rem X dcols) 2))

  (setq mody (/ (rem Y drows) 2))

  (if (> X1 X2)
  

  (setq X1 X2))
  
 (if (> Y1 Y2)
  
  (setq Y1 Y2))
 
(setq ptx (+ modx X1))
  (setq pty (+ mody Y1))

                    
  (setq pt3 (list ptx pty))
  
  (setq county 0)
  (while (< county nrows)

    (setq count 0)
    (setq ptx (+ modx X1))
    (setq pt3 (list ptx pty))

    (while (< count ncols)
                    
      (command "_insert" "light normal.dwg" pt3 "" "" "")
      (setq ptx (+ ptx dcols))
      (setq count (+ 1 count))
      (setq pt3 (list ptx pty))

    )

    (setq pty (+ pty drows))
    

    (setq county (+ 1 county))
    
  )

  (defun draw_vertical_lines ( / x y-pair p1 p2)
  (foreach x xl ; xl could be for example (50 100 150)
    (foreach y-pair (rlxlist yl) ; = ((10 20) (20 30) (30 40)) , 1st y-pair = (10 20), 2nd y-pair = (20 30)
      ; make begin & end point , for example p1 = (list 50 10) , p2 = (list 50 20)
      (setq p1 (list x (car y-pair)) p2 (list x (cadr y-pair)))
     
      (if (member p1 pl)(setq p1 (list x (- (car  y-pair) dy))))
      (if (member p2 pl)(setq p2 (list x (+ (cadr y-pair) dy))))
      
      ; now draw the line
      (command-s ".line" p1 p2 "")
    )
  )
)

(defun draw_horizontal_lines ( / y x-pair p1 p2)
  (foreach y yl
    (foreach x-pair (rlxlist xl)
      (if (member (setq p1 (list (car  x-pair) y)) pl) (setq p1 (list (+ (car  x-pair) dx) y)))
      (if (member (setq p2 (list (cadr x-pair) y)) pl) (setq p2 (list (- (cadr x-pair) dx) y)))
      (command-s ".line" p1 p2 "")
    )
  )
)

; make list of all x-values with fuzz factor , this means no use of member function
(defun Find-X-Values ( %ss / xl )
  (mapcar
    '(lambda ( e / x)
       (setq x (car (getbip e))) (if (null xl) (setq xl (list x)) (if (vl-every '(lambda (n) (not (equal x n fuzz))) xl)(setq xl (cons x xl)))))
     %ss
  )
  (vl-sort xl '<)
)

; make list of all y-values with fuzz factor
(defun Find-Y-Values ( %ss / yl )
  (mapcar
    '(lambda ( e / y)
       (setq y (cadr (getbip e))) (if (null yl) (setq yl (list y)) (if (vl-every '(lambda (n) (not (equal y n fuzz))) yl)(setq yl (cons y yl)))))
     %ss
  )
  (vl-sort yl '>)
)

; list all block insertion points
(defun ListAllBips (l)
  (mapcar 'getbip l)
)
       

(defun rlxlist (l) (reverse (cdr (reverse (mapcar '(lambda (x y)(list x y)) l (append (cdr l) (list (car l))))))))

(defun rlxlist2 (l) (mapcar '(lambda (x y)(list x y)) l (append (cdr l) (list (car l)))))

; get block insertion point
(defun getbip (e) (list (cadr (assoc 10 (entget e)))(caddr (assoc 10 (entget e)))))

; convert selectionset to list
(defun SS->lst (%ss)(vl-remove-if 'listp (mapcar 'cadr (ssnamex %ss))))

  
                
  (setvar 'osmode 15871)

) ;_ end of defun

[Anonymous]

kindly reply me about this lisp given below.

[Kent1Cooper]

That code contains many defined functions that are never used -- all those (defun)s toward the end, I think [I'm not sure without more detailed analysis] everything from  (defun draw_vertical_lines  onward. [Some of them are used in others of them, but since those others are never used....]  It looks like the drawing of Lines is all done by functions that are never asked to do their work.

I might be able to figure out how to get them to do their work, with a lot more evaluation, but do you have access to whoever wrote this?  They would be able to work them in more easily than we can.

[Kent1Cooper]

---

@Kent1Cooper wrote:

That code contains many defined functions that are never used -- ....

---

In addition, on only-slightly-closer inspection I find that there are variables that are called for, but are never defined -- in particular, 'dx' and 'dy' [I didn't search for more, but there may be more].  I might be able to figure out what they should be, with more analysis, but I think you need to go to the source, because I think the code is missing a lot of important content, but if you can just get that from the source, it may work perfectly.

[Anonymous]

hi kent ,

thank you so much your reply.

 this lisp i have been working till now it works fine(this lisp c:t4). another one is sorry, I mingled this lisp itself which I marked the colour that has not come from the original function that is just copied from cadtour forum.

any possible to make connect the line to all block? I will appreciate any help.

thank you so much kent your effort.

(DEFUN c:t4 (/ sc clay)
  (setvar "cmdecho" 0)
  (vl-load-com)

  (setq    util (vla-get-utility
           (vla-get-activedocument
         (vlax-get-acad-object)
           )
         )
  )
  (setq    Pt1
     (getpoint "\nPick First Point")
  )                    ;PROMPT FOR FIRST POINT
  (setq    Pt2
     (getpoint "\nPick Second Point")
  )
;(princ "\nPt1=")
;  (princ Pt1)
;(princ "\nPt2=")
 ; (princ Pt2)
(setq os (getvar 'osmode))
(setvar 'osmode 0)
;;; you codes here ...

  
  (setq    drows (vla-GetReal
        util
        "\nEnter the distance between rows (---): "
          )
  )
  (setq    dcols (vla-GetReal
        util
        "Specify the distance between columns (|||): "
          )
  )
         
  (setq X1 (car Pt1))
  (setq Y1 (car (cdr Pt1)))
  (setq X2 (car Pt2))
  (setq Y2 (car (cdr Pt2)))
                    
  (setq X (abs (- X1 X2)))
  (setq Y (abs (- Y1 Y2)))

 
  (setq ncols (+ 1 (/ (- X (rem X dcols)) dcols)))

  (setq nrows (+ 1 (/ (- Y (rem Y drows)) drows)))

 
  (setq modx (/ (rem X dcols) 2))

  (setq mody (/ (rem Y drows) 2))

  (if (> X1 X2)
  

  (setq X1 X2))
  
 (if (> Y1 Y2)
  
  (setq Y1 Y2))
 
(setq ptx (+ modx X1))
  (setq pty (+ mody Y1))

                    
  (setq pt3 (list ptx pty))
  
  (setq county 0)
  (while (< county nrows)

    (setq count 0)
    (setq ptx (+ modx X1))
    (setq pt3 (list ptx pty))

    (while (< count ncols)
                    
      (command "_insert" "light normal.dwg" pt3 "" "" "")
      (setq ptx (+ ptx dcols))
      (setq count (+ 1 count))
      (setq pt3 (list ptx pty))

    )

    (setq pty (+ pty drows))
    

    (setq county (+ 1 county))

(princ)
    
  )end of defun (just type c:t4)

 (defun draw_vertical_lines ( / x y-pair p1 p2)
  (foreach x xl ; xl could be for example (50 100 150)
    (foreach y-pair (rlxlist yl) ; = ((10 20) (20 30) (30 40)) , 1st y-pair = (10 20), 2nd y-pair = (20 30)
      ; make begin & end point , for example p1 = (list 50 10) , p2 = (list 50 20)
      (setq p1 (list x (car y-pair)) p2 (list x (cadr y-pair)))
     
      (if (member p1 pl)(setq p1 (list x (- (car  y-pair) dy))))
      (if (member p2 pl)(setq p2 (list x (+ (cadr y-pair) dy))))
      
      ; now draw the line
      (command-s ".line" p1 p2 "")
    )
  )
)

(defun draw_horizontal_lines ( / y x-pair p1 p2)
  (foreach y yl
    (foreach x-pair (rlxlist xl)
      (if (member (setq p1 (list (car  x-pair) y)) pl) (setq p1 (list (+ (car  x-pair) dx) y)))
      (if (member (setq p2 (list (cadr x-pair) y)) pl) (setq p2 (list (- (cadr x-pair) dx) y)))
      (command-s ".line" p1 p2 "")
    )
  )
)

; make list of all x-values with fuzz factor , this means no use of member function
(defun Find-X-Values ( %ss / xl )
  (mapcar
    '(lambda ( e / x)
       (setq x (car (getbip e))) (if (null xl) (setq xl (list x)) (if (vl-every '(lambda (n) (not (equal x n fuzz))) xl)(setq xl (cons x xl)))))
     %ss
  )
  (vl-sort xl '<)
)

; make list of all y-values with fuzz factor
(defun Find-Y-Values ( %ss / yl )
  (mapcar
    '(lambda ( e / y)
       (setq y (cadr (getbip e))) (if (null yl) (setq yl (list y)) (if (vl-every '(lambda (n) (not (equal y n fuzz))) yl)(setq yl (cons y yl)))))
     %ss
  )
  (vl-sort yl '>)
)

[Kent1Cooper]

That's still using dx and dy variables that are not defined.  Wherever you got the colored parts from must have more that defines those variables before it uses them.  Look for  (setq dx ...  and  (setq dy ...  somewhere.

[ronjonp]

Give this a try, it's not perfect but better than what you have now :). I added a few comments to help you learn.

(defun c:foo (/ _ds a p p2 s x)
  ;; RJP » 2018-10-30
  (defun _ds (p l) (vl-sort l '(lambda (a b) (< (distance p a) (distance p b)))))
  (cond
    ((setq s (ssget '((0 . "insert"))))
     ;; Get block insertion points from selection set
     (setq s (mapcar '(lambda (x) (cdr (assoc 10 (entget x))))
		     (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	     )
     )
     (foreach p	s
       ;; Sort out points that don't have a block that matches x or y
       (if (vl-some '(lambda (x) (or (equal (car p) (car x) 1e-8) (equal (cadr p) (cadr x) 1e-8)))
		    (vl-remove p s)
	   )
	 (setq a (cons p a))
       )
     )
     ;; Sort smallest y then x
     (setq a (vl-sort a '(lambda (r j) (< (car a) (car b)))))
     (setq a (vl-sort a '(lambda (r j) (< (cadr a) (cadr b)))))
     ;; Process points while there are at least 2
     (while (cadr a)
       ;; Set first point
       (setq p (car a))
       ;; Remove first point from list
       (setq a (cdr a))
       ;; Does another point match the x val?
       (if (setq p2 (vl-some '(lambda (x) (cond ((equal (car p) (car x) 1e-8) x))) a))
	 (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (polar p (angle p p2) (distance p p2))))
	 )
       )
       ;; Does another point match the y val?
       (if (setq p2 (vl-some '(lambda (x) (cond ((equal (cadr p) (cadr x) 1e-8) x))) a))
	 (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (polar p (angle p p2) (distance p p2))))
	 )
       )
       (redraw)
     )
    )
  )
  (princ)
)
(vl-load-com)

 

[Anonymous]

hi kent

thank you so much your reply.ok anyway i will look which you mentioned about (setq dx) and (setq dy).

i will appreciate your help and effort.

best regards 

hussain

[Anonymous]

hi rperez

thank you so much your reply.

Already, i using the same lisp; but, not exact same your lisp. it quite different than lisp. i don't want to use two lisps at the same time because of I am creating lighting drawing for the big factory. i want to use lisp for both of them(connect line with block one time). is this possible to create for me? if no time.no problem.

Anyway, again thank you so much that you created lisp for me.

best regards 

hussain

[ronjonp]

This modified code does not lay out your lights for you but still may help with the connections. Enter the min and max distance to search at the top of the code.

(defun c:foo (/ a f mn mx p p2 s x)
  ;; RJP » 2018-10-31
  ;; Set your min and max search distance here .. then you should be able to do the whole drawing at once
  (setq mn 5.)
  (setq mx 30.)
  ;; Fuzz value to determine equality
  (setq f 1e-8)
  (cond
    ((and (setq s (ssget '((0 . "insert")))))
     ;; Get block insertion points from selection set
     (setq a (mapcar '(lambda (x) (cdr (assoc 10 (entget x))))
		     (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	     )
     )
     ;; Process points while there are at least 2
     (while (cadr a)
       ;; Set first point
       (setq p (car a))
       ;; Remove first point from list
       (setq a (cdr a))
       ;; Remove points that are too far away or too close and don't match the current x value
       (if (setq p2 (car (vl-remove-if-not
			   '(lambda (x) (and (equal (car p) (car x) f) (<= mn (distance p x) mx)))
			   a
			 )
		    )
	   )
	 (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (polar p (angle p p2) (distance p p2))))
	 )
       )
       ;; Remove points that are too far away or too close and don't match the current y value
       (if (setq p2 (car (vl-remove-if-not
			   '(lambda (x) (and (equal (cadr p) (cadr x) f) (<= mn (distance p x) mx)))
			   a
			 )
		    )
	   )
	 (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (polar p (angle p p2) (distance p p2))))
	 )
       )
     )
    )
  )
  (princ)
)
(vl-load-com)

[Anonymous]

---

@Anonymous wrote:

hi rperez

thank you so much your reply.

Already, i using the same lisp; but, not exact same your lisp. it quite different than lisp. i don't want to use two lisps at the same time because of I am creating lighting drawing for the big factory. i want to use lisp for both of them(connect line with block one time). is this possible to create for me? if no time.no problem.

Anyway, again thank you so much that you created lisp for me.

best regards 

hussain

---

hi rperez

sorry for the delay message. i think i typed by mistakenly above what i mentioned. i mean, I using two lisp(one is to create a lighting block (which i used lisp command c:t4)and another one is connecting the block with the line(using your lisp c:foo)) i want to do, one lisp to create  lighting block and connect the block with line itself. i hope you will understand everything.

sorry for the disturbing you. thank you so much your effort.

best regards 

hussain

[dbhunia · Accepted solution]

Hi,

You simply combine "rperez code" code with your "T4 Code" (with little modification Blue one)......... Like....(this is very rough modification)

(DEFUN c:t4 (/ sc clay a f mn mx p p2 s x)
  (setvar "cmdecho" 0)
  (vl-load-com)

  (setq    util (vla-get-utility
           (vla-get-activedocument
         (vlax-get-acad-object)
           )
         )
  )
  (setq    Pt1
     (getpoint "\nPick First Point")
  )                    ;PROMPT FOR FIRST POINT
  (setq    Pt2
     (getpoint "\nPick Second Point")
  )
;(princ "\nPt1=")
;  (princ Pt1)
;(princ "\nPt2=")
 ; (princ Pt2)
(setq os (getvar 'osmode))
(setvar 'osmode 0)
;;; you codes here ...

  
  (setq    drows (vla-GetReal
        util
        "\nEnter the distance between rows (---): "
          )
  )
  (setq    dcols (vla-GetReal
        util
        "Specify the distance between columns (|||): "
          )
  )
         
  (setq X1 (car Pt1))
  (setq Y1 (car (cdr Pt1)))
  (setq X2 (car Pt2))
  (setq Y2 (car (cdr Pt2)))
                  
  (setq X (abs (- X1 X2)))
  (setq Y (abs (- Y1 Y2)))
  (setq ncols (+ 1 (/ (- X (rem X dcols)) dcols)))
  (setq nrows (+ 1 (/ (- Y (rem Y drows)) drows)))
  (setq modx (/ (rem X dcols) 2))
  (setq mody (/ (rem Y drows) 2))
  (if (> X1 X2)
  (setq X1 X2))
 (if (> Y1 Y2)
  (setq Y1 Y2))
 
(setq ptx (+ modx X1))
  (setq pty (+ mody Y1))
  (setq pt3 (list ptx pty))
  (setq county 0)
  (while (< county nrows)

    (setq count 0)
    (setq ptx (+ modx X1))
    (setq pt3 (list ptx pty))

    (while (< count ncols)
                    
      (command "_insert" "light normal.dwg" pt3 "" "" "")
      (setq ptx (+ ptx dcols))
      (setq count (+ 1 count))
      (setq pt3 (list ptx pty))

    )
    (setq pty (+ pty drows))
    (setq county (+ 1 county))

;(princ)
)

;//////////////////////////////////////// rperez code ///////////////////////
  ;; RJP » 2018-10-31
  ;; Set your min and max search distance here .. then you should be able to do the whole drawing at once
  (setq mn 5.)
  (setq mx 30.)
  ;; Fuzz value to determine equality
  (setq f 1e-8)
  (cond
    ((and (setq s (ssget "_c" pt2 pt1)))
     ;; Get block insertion points from selection set
     (setq a (mapcar '(lambda (x) (cdr (assoc 10 (entget x))))
		     (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	     )
     )
     ;; Process points while there are at least 2
     (while (cadr a)
       ;; Set first point
       (setq p (car a))
       ;; Remove first point from list
       (setq a (cdr a))
       ;; Remove points that are too far away or too close and don't match the current x value
       (if (setq p2 (car (vl-remove-if-not
			   '(lambda (x) (and (equal (car p) (car x) f) (<= mn (distance p x) mx)))
			   a
			 )
		    )
	   )
	 (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (polar p (angle p p2) (distance p p2))))
	 )
       )
       ;; Remove points that are too far away or too close and don't match the current y value
       (if (setq p2 (car (vl-remove-if-not
			   '(lambda (x) (and (equal (cadr p) (cadr x) f) (<= mn (distance p x) mx)))
			   a
			 )
		    )
	   )
	 (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (polar p (angle p p2) (distance p p2))))
	 )
       )
     )
    )
  )
  (princ)

(vl-load-com)
;//////////////////////////////////////// rperez code ///////////////////////

);end of defun (just type c:t4)

gfafgdgasas

[Anonymous]

hi dbhunia

thank you so much your help. this is i looking one. i am very happy now.

thank you so much to everyone those who helped to me.