Connecting the selected blocks to the line

July 20, 2022

That should be working for you & it is on this end. tho a little bug with autocad is if your zoomed out too much it might snap to something other then attended when using points. putting "_non" in front of the point usually fixes this issue.

      (cond
        ((and (equal (car p1) (car p2) 0.001) (> (cadr p1) (cadr p2)))
          (setq l1 (car (nentselp "_non" p3)))
        )
        ((and (equal (car p1) (car p2) 0.001) (< (cadr p1) (cadr p2)))
          (setq l1 (car (nentselp "_non" p4)))
        )
        ((< (car p1) (car p2))
          (setq l1 (car (nentselp "_non" p3)))
        )
        ((> (car p1) (car p2))
          (setq l1 (car (nentselp "_non" p4)))
        )
      )

July 20, 2022

I opened a new dwg then just drew a line with blocks and tried the zoom event. As you said, you don't even need to have an object next to it. I tried the code after zooming out the drawing and couldn't draw but when I zoomed in and tried the code worked. Thank you for your time and help

July 20, 2022

Could add a zoom to obj and back out to make sure it works. But would kinda flicker the screen and add a little time to the lisp.

July 21, 2022

osmode 0 should fix works in 99% of cases.

Maybe a zoom C scale around line picked so see on screen at reasonable scale.

I have been doing stuff replace 1000 blocks, new text, new leader in a dwg so zoom e 1st and no problems. Bricscad and Acad. Watch the fly spec appear.

August 10, 2022

Updating code. sorting blocks from insertion point works if all blocks are basically in a line. if their are deviations off the line then the code might not work depending on the rotation. This code fixes those issues and makes the code work both in AutoCAD and BricsCAD with out having to change > around depending on what software you use. it also uses zoom to object to make sure nentselp is working even if your zoomed out.

;;----------------------------------------------------------------------;;
;; CONNECT BLOCK TO LINE
(defun C:FOO (/ r ss line p1 p2 p3 p4 brkpts)
  (or (setq r (vlax-ldata-get "radius" "R")) (C:SETUP)) ;thanks ronjonp
  (setq ss (ssget '((0 . "INSERT"))))
  (setq line (car (entsel "\nSelect Line: ")))   
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq p1 (vlax-get (vlax-ename->vla-object ent) 'InsertionPoint))
    (setq p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object line) p1))
    (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
    (setq p3 (polar p2 (+ (angle p1 p2) (/ pi 2)) r))
    (setq brkpts (cons p3 brkpts))
    (setq p4 (polar p2 (- (angle p1 p2) (/ pi 2)) r))
    (setq brkpts (cons p4 brkpts))
    (entmake (list (cons 0 "ARC") (cons 10 p2) (cons 40 r) (cons 50 (angle p2 p3)) (cons 51 (angle p2 p4))))
  )
  (setq brklst
        (vl-sort brklst
                 '(lambda (a b)
                    (if (equal (car a) (car b) 1e-6)
                      (> (cadr a) (cadr b))
                      (> (car a) (car b))
                    )
                  )
        )
  )
  (setvar 'cmdecho 0) 
  (command "_view" "_S" "Prebreak") ;save zoom location
  (repeat (/ (length brkpts) 2)
    (setq p5 (mapcar '/ (mapcar '+ (car brkpts) (cadr brkpts)) '(2 2 2)))
    (entmake (list (cons 0 "CIRCLE") (cons 10 p5) (cons 40 r))) 
    (setq cir (entlast))
    (command "_.Zoom" "_OB" cir "") ;zoom to trim location
    (command "TRIM" cir "")
    (command (nentselp p5))
    (command (nentselp p5))
    (command "")
    (entdel cir)
    (setq brkpts (cddr brkpts))
  )
  (command "_View" "_R" "Prebreak") ;load zoom location
  (setvar 'cmdecho 1)  
  (princ)
)
;;----------------------------------------------------------------------;;
;; SETS R FOR FOO COMMAND
(defun C:SETUP ()
  (or (setq *r (vlax-ldata-get "Radius" "R")) (setq *r 0.500))
  (if (setq r (getdist (strcat "\nSet Radius [" (rtos *r 2) "]: ")))
    (vlax-ldata-put "Radius" "R" r)
    (vlax-ldata-put "Radius" "R" (setq r *r))
  )
)

Edited August 11, 2022 by mhupp
forgot cmdecho

August 11, 2022

Thank you for correcting the errors in the code.

August 12, 2022

I used this code today. It works fast in an empty dwg, but when drawing a project it takes 2 minutes to include 10 blocks in the line. I guess using it in the trim command after creating a circle causes the code to run slowly.

I tried to fix this situation as follows. It does the 2 minute process in 5-6 seconds now but %95 worked ( i tried 50-60 times). If the blocks are both close to each other and close to the line, it may delete part of the line.

;;----------------------------------------------------------------------;;
;; CONNECT BLOCK TO LINE
(defun C:FOO (/ r ss line p1 p2 p3 p4 brkpts)
  (or (setq r (vlax-ldata-get "radius" "R")) (C:SETUP)) ;thanks ronjonp
  (setq ss (ssget '((0 . "INSERT"))))
  (setq line (car (entsel "\nSelect Line: ")))   
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq p1 (vlax-get (vlax-ename->vla-object ent) 'InsertionPoint))
    (setq p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object line) p1))
    (setq p3 (polar p2 (+ (angle p1 p2) (/ pi 2)) r))
    (setq brkpts (cons p3 brkpts))
    (setq p4 (polar p2 (- (angle p1 p2) (/ pi 2)) r))
    (setq brkpts (cons p4 brkpts))
    (setq p6 (polar p2 (+ (angle p1 p2) pi) r))
    (entmake (list (cons 0 "LINE") (cons 10 p6) (cons 11 p1)))
    (entmake (list (cons 0 "ARC") (cons 10 p2) (cons 40 r) (cons 50 (angle p2 p3)) (cons 51 (angle p2 p4))))
  )
  (setq brkpts
        (vl-sort brkpts
                 '(lambda (a b)
                    (if (equal (car a) (car b) 1e-6)
                      (> (cadr a) (cadr b))
                      (> (car a) (car b))
                    )
                  )
        )
  )
  (setvar 'cmdecho 0) 
  (command "_view" "_S" "Prebreak") ;save zoom location
  (repeat (/ (length brkpts) 2)
    (setq p5 (mapcar '/ (mapcar '+ (car brkpts) (cadr brkpts)) '(2 2 2)))
    (command "Zoom" "_w" (car brkpts) (cadr brkpts)) ;zoom to trim location
    (command "TRIM" "" (nentselp p5)"")
    (command (nentselp p5))
    (command (nentselp p5))
    (setq brkpts (cddr brkpts))
  )
  (command "_View" "_R" "Prebreak") ;load zoom location
  (setvar 'cmdecho 1)  
  (princ)
)
;;----------------------------------------------------------------------;;
;; SETS R FOR FOO COMMAND
(defun C:SETUP ()
  (or (setq *r (vlax-ldata-get "Radius" "R")) (setq *r 0.500))
  (if (setq r (getdist (strcat "\nSet Radius [" (rtos *r 2) "]: ")))
    (vlax-ldata-put "Radius" "R" r)
    (vlax-ldata-put "Radius" "R" (setq r *r))
  )
)

Edit;
(setq brklst
       (vl-sort brklst ; changed
 (setq brkpts
       (vl-sort brkpts ;
I haven't tested it but now it can work %100.

Edited August 12, 2022 by Scoutr4
Edit : code fix

August 12, 2022

no clue why it would take so long. visual styles usually hinder my pc when zooming around.

entmake shouldn't account for the long time either.

also since all points are on a line. -EDIT you no loner need a sort function.

Edited August 12, 2022 by mhupp

August 12, 2022

3 hours ago, mhupp said:
(setq brkpts (vl-sort brkpts <))

I changed this row. Repeat line does not work.

August 12, 2022

Actually the sort function isn't needed and only one trim since your calculating p5.

See if this fixes your 2min problem.

;;----------------------------------------------------------------------;;
;; CONNECT BLOCK TO LINE
(defun C:FOO (/ r ss line p1 p2 p3 p4 brkpts)
  (or (setq r (vlax-ldata-get "radius" "R")) (C:SETUP)) ;thanks ronjonp
  (setq ss (ssget '((0 . "INSERT")))
        line (car (entsel "\nSelect Line: "))
  )   
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq p1 (vlax-get (vlax-ename->vla-object ent) 'InsertionPoint)
          p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object line) p1)
          p3 (polar p2 (+ (angle p1 p2) (/ pi 2)) r)
          brkpts (cons p3 brkpts)
          p4 (polar p2 (- (angle p1 p2) (/ pi 2)) r)
          brkpts (cons p4 brkpts)
          p5 (polar p2 (+ (angle p1 p2) pi) r)
    )
    (entmake (list (cons 0 "LINE") (cons 10 p5) (cons 11 p1)))
    (entmake (list (cons 0 "ARC") (cons 10 p2) (cons 40 r) (cons 50 (angle p2 p3)) (cons 51 (angle p2 p4))))
  )
  (setvar 'cmdecho 0) 
  (command "_view" "_S" "Prebreak") ;save zoom location
  (repeat (/ (length brkpts) 2)
    (setq p6 (mapcar '/ (mapcar '+ (car brkpts) (cadr brkpts)) '(2 2 2)))
    (command "Zoom" "_w" (car brkpts) (cadr brkpts)) ;zoom to trim location
    (command "TRIM" "" (nentselp p6) "")
    (setq brkpts (cddr brkpts))
  )
  (command "_View" "_R" "Prebreak") ;load zoom location
  (setvar 'cmdecho 1)  
  (princ)
)
;;----------------------------------------------------------------------;;
;; SETS R FOR FOO COMMAND
(defun C:SETUP ()
  (or (setq *r (vlax-ldata-get "Radius" "R")) (setq *r 0.500))
  (if (setq r (getdist (strcat "\nSet Radius [" (rtos *r 2) "]: ")))
    (vlax-ldata-put "Radius" "R" r)
    (vlax-ldata-put "Radius" "R" (setq r *r))
  )
)

August 12, 2022

I am checked it and finally i found the error. This trim command sometimes exceeds its limit and cuts the line to the until other arc. I re-added the circle the trim command doesn't get the reference circle so it doesn't take like 1 or 2 mins. I tried code and %100 working now.

;;----------------------------------------------------------------------;;
;; CONNECT BLOCK TO LINE
(defun C:FOO (/ r ss line p1 p2 p3 p4 brkpts)
  (or (setq r (vlax-ldata-get "radius" "R")) (C:SETUP)) ;thanks ronjonp
  (setq ss (ssget '((0 . "INSERT"))))
  (setq line (car (entsel "\nSelect Line: ")))   
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq p1 (vlax-get (vlax-ename->vla-object ent) 'InsertionPoint))
    (setq p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object line) p1))
    (setq p3 (polar p2 (+ (angle p1 p2) (/ pi 2)) r))
    (setq brkpts (cons p3 brkpts))
    (setq p4 (polar p2 (- (angle p1 p2) (/ pi 2)) r))
    (setq brkpts (cons p4 brkpts))
    (setq p5 (polar p2 (+ (angle p1 p2) pi) r))
    (entmake (list (cons 0 "LINE") (cons 10 p5) (cons 11 p1)))
    (entmake (list (cons 0 "ARC") (cons 10 p2) (cons 40 r) (cons 50 (angle p2 p3)) (cons 51 (angle p2 p4)))))
  (setq brkpts
        (vl-sort brkpts
                 '(lambda (a b)
                    (if (equal (car a) (car b) 1e-6)
                      (> (cadr a) (cadr b))
                      (> (car a) (car b))
                    )
                  )
        )
  )
  (setvar "cmdecho" 0) 
  (command "_view" "_S" "Prebreak") ;save zoom location 
  (repeat (/ (length brkpts) 2)
    (setq p6 (mapcar '/ (mapcar '+ (car brkpts) (cadr brkpts)) '(2 2 2)))
    (command "Zoom" "_w" (car brkpts) (cadr brkpts)) ;zoom to trim location
    (entmake (list (cons 0 "CIRCLE") (cons 10 p6) (cons 40 r))) 
    (setq cir (entlast))
    (command "TRIM" "" (nentselp p6)"")
    (entdel cir)
    (setq brkpts (cddr brkpts))
  )
  (command "_View" "_R" "Prebreak") ;load zoom location
  (princ)
)
;;----------------------------------------------------------------------;;
;; SETS R FOR FOO COMMAND
(defun C:SETUP ()
  (or (setq *r (vlax-ldata-get "Radius" "R")) (setq *r 0.500))
  (if (setq r (getdist (strcat "\nSet Radius [" (rtos *r 2) "]: ")))
    (vlax-ldata-put "Radius" "R" r)
    (vlax-ldata-put "Radius" "R" (setq r *r))
  )
)

Edited August 12, 2022 by Scoutr4

August 12, 2022

If your going to make the circle then add it to the trim command.

(command "TRIM" cir "" (nentselp p6) "")
;(command (nentselp p6)) not needed
;(command (nentselp p6)) not needed
(entdel cir)

Edited August 12, 2022 by mhupp

August 12, 2022

This is how my blocks are setup so you don't have to do any trimming.

Then with another masked block you can do this:

Edited August 12, 2022 by ronjonp

August 12, 2022

@ronjonp Nice. this is looking faster than currently code but but the connection shape can go from 2 lines to 3 lines. Then i will have to call different block. How did you prepare this code?

while doing this code ;
You identified p1 and p2, then drew a line from p1 to p2. Then this code placed the base point of the block at p2 after then took the angle of the line and set it as the block angle

Are these steps correct?

Edit : I plan mostly use foo code. The code you show can be useful for environmental projects. (such as garden, parking lot and open space)

Edited August 12, 2022 by Scoutr4

August 12, 2022

21 minutes ago, Scoutr4 said:

@ronjonp Nice. this is looking faster than currently code but but the connection shape can go from 2 lines to 3 lines. Then i will have to call different block. How did you prepare this code?

while doing this code ;
You identified p1 and p2, then drew a line from p1 to p2. Then this code placed the base point of the block at p2 after then took the angle of the line and set it as the block angle

Are these steps correct?

Pretty close .. here is the code if you want to study it. It's a quick mod of the code HERE.

(defun c:foo (/ _dxf _sl _foo a b c e p s x)
  ;; RJP » 2019-01-10
  (defun _foo nil
    (cond ((null (tblobjname "block" "triangle"))
	   (entmake '((0 . "BLOCK")
		      (100 . "AcDbEntity")
		      (67 . 0)
		      (8 . "0")
		      (100 . "AcDbBlockReference")
		      (2 . "triangle")
		      (10 0. 0. 0.)
		      (70 . 0)
		     )
	   )
	   (entmake '((0 . "HATCH")
		      (100 . "AcDbEntity")
		      (8 . "0")
		      (62 . 7)
		      (420 . 16777215)
		      (100 . "AcDbHatch")
		      (10 0. 0. 0.)
		      (210 0. 0. 1.)
		      (2 . "SOLID")
		      (70 . 1)
		      (71 . 0)
		      (91 . 1)
		      (92 . 1)
		      (93 . 3)
		      (72 . 1)
		      (10 0.722608815692048 -0.0155020345055 0.)
		      (11 0. 0.707106781186548 0.)
		      (72 . 1)
		      (10 0. 0.707106781186548 0.)
		      (11 -0.722608815692047 -0.0155020345055 0.)
		      (72 . 1)
		      (10 -0.722608815692047 -0.0155020345055 0.)
		      (11 0.722608815692048 -0.0155020345055 0.)
		      (97 . 0)
		      (75 . 1)
		      (76 . 1)
		      (98 . 1)
		      (10 -32.1702098677918 -13.02209665774993 0.)
		      (450 . 0)
		      (451 . 0)
		      (460 . 0.)
		      (461 . 0.)
		      (452 . 0)
		      (462 . 0.)
		      (453 . 2)
		      (463 . 0.)
		      (63 . 5)
		      (421 . 255)
		      (463 . 1.)
		      (63 . 2)
		      (421 . 16776960)
		      (470 . "LINEAR")
		     )
	   )
	   (entmake '((0 . "LWPOLYLINE")
		      (100 . "AcDbEntity")
		      (67 . 0)
		      (8 . "0")
		      (62 . 0)
		      (100 . "AcDbPolyline")
		      (90 . 3)
		      (70 . 128)
		      (43 . 0.)
		      (38 . 0.)
		      (39 . 0.)
		      (10 0.722608815692048 -0.0155020345055)
		      (40 . 0.)
		      (41 . 0.)
		      (42 . 0.)
		      (91 . 0)
		      (10 0. 0.707106781186548)
		      (40 . 0.)
		      (41 . 0.)
		      (42 . 0.)
		      (91 . 0)
		      (10 -0.722608815692047 -0.0155020345055)
		      (40 . 0.)
		      (41 . 0.)
		      (42 . 0.)
		      (91 . 0)
		     )
	   )
	   (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
	  )
    )
    (princ)
  )
  (_foo)
  (defun _sl (s) (cond ((= 'pickset (type s)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))))
  (defun _dxf (c e) (cdr (assoc c (entget e))))
  (cond
    ((setq s (_sl (ssget)))
     (foreach x	s
       (if (wcmatch (_dxf 0 x) "CIRCLE,INSERT,POINT")
	 (setq b (cons (_dxf 10 x) b))
	 (and (= 'real (type (vl-catch-all-apply 'vlax-curve-getendparam (list x))))
	      (setq a (cons x a))
	 )
       )
     )
     (and a
	  b
	  (foreach p b
	    (setq c
		   (mapcar '(lambda (x)
			      (list (setq c (vlax-curve-getclosestpointto x p)) (distance p c) (_dxf 8 x))
			    )
			   a
		   )
	    )
	    (setq c (car (vl-sort c '(lambda (r j) (< (cadr r) (cadr j))))))
	    (if	(not (equal 0 (cadr c) 1e-3))
	      (progn (setq
		       e (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (car c)) (cons 8 (caddr c))))
		     )
		     ;; This line below creates the right example comment out to get left
		     ;; (setq a (cons e a))
		     (entmake (list '(0 . "INSERT")
				    '(100 . "AcDbEntity")
				    '(67 . 0)
				    '(8 . "Triangle")
				    '(62 . 1)
				    '(100 . "AcDbBlockReference")
				    '(2 . "triangle")
				    (cons 10 (car c))
				    ;; The block scale will need to be adjusted for your drawings
				    '
				     (41 . 0.15)
				    '(42 . 0.15)
				    '(43 . 0.15)
				    (cons 50 (+ (angle p (car c)) (/ pi 2)))
			      )
		     )
	      )
	    )
	  )
     )
    )
  )
  (princ)
)

Edited August 12, 2022 by ronjonp

August 12, 2022

nice tactic it may work for me . Thank you @ronjonp

August 12, 2022

2 minutes ago, Scoutr4 said:

nice tactic it may work for me . Thank you @ronjonp

Glad to help

August 13, 2022

i found your another message and i made the circle version. https://www.cadtutor.net/forum/topic/69659-how-can-i-make-a-block-of-a-circle-in-order-to-put-a-color/?tab=comments#comment-560806

I add it here for anyone who needs it to use.

(defun c:foo (/ _dxf _sl _foo a b c e p s x)
  ;; RJP » 2019-01-10
 (or d (setq d (getdist "\nScale: ")))
  (defun _foo nil
    (cond ((null (tblobjname "block" "Circle"))
	   (entmake '((0 . "BLOCK")
		      (100 . "AcDbEntity")
		      (67 . 0)
		      (8 . "0")
		      (100 . "AcDbBlockReference")
		      (2 . "Circle")
		      (10 0. 0. 0.)
		      (70 . 0)
		     )
	   )
(entmake '((0 . "HATCH")
		       (100 . "AcDbEntity")
		       (8 . "hatch")
		       (100 . "AcDbHatch")
		       (10 0. 0. 0.)
		       (210 0. 0. 1.)
		       (2 . "SOLID")
		       (70 . 1)
		       (71 . 0)
		       (91 . 1)
		       (92 . 1)
		       (93 . 1)
		       (72 . 2)
		       (10 0. 0. 0.)
		       (40 . 0.5)
		       (50 . 0.)
		       (51 . 6.283185307179588)
		       (73 . 1)
		       (97 . 0)
		       (75 . 1)
		       (76 . 1)
		       (98 . 1)
		       (10 0. 0. 0.)
		       (450 . 0)
		       (451 . 0)
		       (460 . 0.)
		       (461 . 0.)
		       (452 . 0)
		       (462 . 0.)
		       (453 . 2)
		       (463 . 0.)
		       (63 . 5)
		       (421 . 255)
		       (463 . 1.)
		       (63 . 2)
		       (421 . 16776960)
		       (470 . "LINEAR")
		      )
    )
(entmake '((0 . "CIRCLE")
              (100 . "AcDbEntity")
              (67 . 0)
		       (8 . "0")
		       (62 . 7)
		       (100 . "AcDbCircle")
		       (10 0. 0. 0.)
		       (40 . 0.5)
	     )
    )
	   (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
	  )
    )
    (princ)
  )
  (_foo)
  (defun _sl (s) (cond ((= 'pickset (type s)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))))
  (defun _dxf (c e) (cdr (assoc c (entget e))))
  (cond
    ((setq s (_sl (ssget)))
     (foreach x	s
       (if (wcmatch (_dxf 0 x) "CIRCLE,INSERT,POINT")
	 (setq b (cons (_dxf 10 x) b))
	 (and (= 'real (type (vl-catch-all-apply 'vlax-curve-getendparam (list x))))
	      (setq a (cons x a))
	 )
       )
     )
     (and a
	  b
	  (foreach p b
	    (setq c
		   (mapcar '(lambda (x)
			      (list (setq c (vlax-curve-getclosestpointto x p)) (distance p c) (_dxf 8 x))
			    )
			   a
		   )
	    )
	    (setq c (car (vl-sort c '(lambda (r j) (< (cadr r) (cadr j))))))
	    (if	(not (equal 0 (cadr c) 1e-3))
	      (progn (setq
		       e (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (car c)) (cons 8 (caddr c))))
		     )
		     ;; This line below creates the right example comment out to get left
		     ;; (setq a (cons e a))
                     ;; 
                   
		     (entmake (list '(0 . "INSERT")
				    '(100 . "AcDbEntity")
				    '(67 . 0)
				    '(8 . "Circle")
				    '(62 . 1)
				    '(100 . "AcDbBlockReference")
				    '(2 . "Circle")
				    (cons 10 (car c))
				    (cons 41 d)
				    (cons 42 d)
				    (cons 43 d)
				    (cons 50 (+ (angle p (car c)) (/ pi 2)))
			      )
		     )
	      )
	    )
	  )
     )
    )
  )
  (princ)
)

Edited August 13, 2022 by Scoutr4

Sign In

Connecting the selected blocks to the line

Recommended Posts

mhupp

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

ronjonp

mhupp

Scoutr4

Posted Images

Scoutr4

mhupp

BIGAL

mhupp

Scoutr4

Scoutr4

mhupp

Scoutr4

mhupp

Scoutr4

mhupp

ronjonp

Scoutr4

ronjonp

Scoutr4

ronjonp

Scoutr4

Join the conversation

ronjonp

mhupp

Scoutr4

Tutorials

Forums

Activity