Jump to content

Connecting the selected blocks to the line


Scoutr4

Recommended Posts

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)))
        )
      )

 

  • Agree 1
Link to comment
Share on other sites

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👍

Link to comment
Share on other sites

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.

  • Like 1
Link to comment
Share on other sites

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.

  • Like 1
Link to comment
Share on other sites

  • 3 weeks later...

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 by mhupp
forgot cmdecho
  • Like 1
Link to comment
Share on other sites

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 by Scoutr4
Edit : code fix
Link to comment
Share on other sites

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 by mhupp
Link to comment
Share on other sites

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))
  )
)

 

Link to comment
Share on other sites

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 by Scoutr4
  • Like 1
Link to comment
Share on other sites

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 by mhupp
  • Agree 1
Link to comment
Share on other sites

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

image.thumb.png.9efb5e5da4915c8fa8e4db08c7cfb4d6.png

 

Then with another masked block you can do this:

2022-08-12_12-21-19.thumb.gif.9a9ad53bac9a7a8a66e27298f984086c.gif

Edited by ronjonp
Link to comment
Share on other sites

@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 by Scoutr4
Link to comment
Share on other sites

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 by ronjonp
  • Like 2
Link to comment
Share on other sites

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 by Scoutr4
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...