Connecting the selected blocks to the line

[Scoutr4]

Hi everyone,

I want to connect the selected blocks to the line . I searched the forums but couldn't find the lisp I wanted.

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/break-amp-fillet-amp-join-a-polyline-line/td-p/10707334

This lisp works with polylines and we always click blocks one by one.  It works fine, but I draw with lines(not polyline) and I need to select many blocks at once.

Do you know a lisp like the one in the screenshot?  Or can someone help?

[Steven P]

How are your LISP skills? Could always select the line, and use (command "pedit" ......) working through PEDIT om the screen for what to put in and create a polyline that way. Might put in an if statement just before that to check if the selected line is a polyline or a line.... reckon that is the first problem solved? Should be able to find the line selection part and work it out?

 

With the blocks, find the selection part of the code, and replace it with a selection set, filtering it to only select blocks (there are examples online), then loop through this selection one by one, would that work I wonder?

 

 

Sunday nighty here, no CAD... but these are ideas

[mhupp]

This should get you what you want. insertion point of block needs to be in the middle of block.

 

If you don't want to be asked about the radius or will always have the same chamfer distance change the first line of code

(or (setq r (getdist (strcat "\nSet Radius [0.500]: "))) (setq r 0.500))
change to
(setq r 0.500) ;chamfer dist of 0.500 0.500

 

 

;;----------------------------------------------------------------------;;
;; CONNECT BLOCK TO LINE
(defun c:foo (/ r ss blklst l1 sp ep mpt p1 p2 l2 cir p3 p4 p5)
  (or (setq r (getdist (strcat "\nSet Radius [0.500]: "))) (setq r 0.500)) 
  (setq ss (ssget '((0 . "INSERT"))))
  (setq blklst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
  (setq blklst ;sorts top down left to right from insertion point
    (mapcar 'cadr
      (vl-sort blklst
       '(lambda (a b)
          (if (equal (caar a) (caar b) 1e-6)
            (< (car (car a)) (car (car b)))
            (> (cadr (car a)) (cadr (car b)))
          )
        )
      )
    )
  )
  (if (setq l1 (car (entsel "\nSelect Line: "))) 
    (progn																	
      (setq sp (cdr (assoc 10 (setq x (entget l1))))
            ep (cdr (assoc 11 x))
            mpt (mapcar '/ (mapcar '+ sp ep) '(2 2 2))
      )
      (if (> (- (angle sp ep) pi) 0)
        (command "_.Rotate" l1 "" mpt 180)
      )
    )
  ) 
  (setvar 'cmdecho 0)
  (foreach ent Blklst
    (setq p1 (vlax-get (vlax-ename->vla-object ent) 'InsertionPoint))
    (setq p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object l1) p1))
    (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
    (setq l2 (entlast))
    (entmake (list (cons 0 "CIRCLE") (cons 10 p2) (cons 40 r))) 
    (setq cir (entlast))
    (setq p3 (polar p2 (+ (angle p1 p2) (/ pi 2)) r))
    (setq p4 (polar p2 (+ (angle p1 p2) pi) r))
    (setq p5 (polar p2 (- (angle p1 p2) (/ pi 2)) r))    
    (command "TRIM" cir "")
    (command (list l1 p2))
    (command (list l2 p2))
    (command "")
    (entmake (list (cons 0 "LINE") (cons 10 p3) (cons 11 p4)))
    (entmake (list (cons 0 "LINE") (cons 10 p4) (cons 11 p5)))
    (entdel cir)
  )
  (setvar 'cmdecho 1)
  (princ)
)

 

Edited July 18, 2022 by mhupp

[BIGAL]

Just some ideas. For lines v's circles maybe use 2 IF's one to make Arcs the other Chamfers.

 

The radius now (strcat "\nSet Radius / Chamfer [0.500]: ")

 

For 1 question -ve value for chamfer + ve for arc, saves extra question. Can test value.

 

 

Edited July 18, 2022 by BIGAL

[Scoutr4]

 

@Steven P my lisp skills are bad.  I looked at the pedit command as you said.  I tried with examples but I could only draw a line between the block and the line.

@mhupp thank you for the code but when i try the code all blocks try to connect to the same point. 

[mhupp]

40 minutes ago, Scoutr4 said:

@mhupp thank you for the code but when i try the code all blocks try to connect to the same point. 

 

 

This is how it should work. The trim command in Bricscad the starting point of the line has to be on top. I guess in AutoCAD its reversed.

 

 

updated code  or re select above code.

(if (< (- (angle sp ep) pi) 0)
to
(if (> (- (angle sp ep) pi) 0)

 

[Scoutr4]

Thank you very much for taking your time for the code !  now it's time for me to draw fast.
  

[Scoutr4]

I changed the code to draw it in arc shape and it worked fine.  

just a little slow.

   ; I deleted these two lines
(entmake (list (cons 0 "LINE") (cons 10 p3) (cons 11 p4)))
(entmake (list (cons 0 "LINE") (cons 10 p4) (cons 11 p5)))
   ; I added these two lines
(command "arc" p4 "e" p3 "r" r)
(command "arc" p5 "e" p4 "r" r)

 

I edited it to ask the Radius question once but it didn't work, why?

    ; I deleted this line
(or (setq r (getdist (strcat "\nSet Radius [0.500]: "))) (setq r 0.500)) 
    ; I added these lines
(defun c:f2R ()(setq r nil)(c:f2)) 
(defun c:f2 (/ r ss blklst l1 sp ep mpt p1 p2 l2 cir p3 p4 p5)
(if (= r nil)
(progn
(setq r (getdist (strcat "\nRadius : ")))))

 

Edited July 19, 2022 by Scoutr4

[mhupp]

what do you want only once and repeate command ? or only ask for radius in each drawing? or you could hard code it. to always be the same.  

[Scoutr4]

I want the code to ask the Radius question once. if I want to new radius again, let me enter  again with another code.

Edited July 19, 2022 by Scoutr4

[mhupp]

This uses ldata so the variable is saved to the drawing. If it hasn't been saved yet it will run "SETUP" use this command to change the radius.

if the radius has been set it will skip and ask you to select blocks. then line.

 

This command will repeat until canceled by not selecting more blocks.

updated entmake to make arcs rather then lines.

 

--edit

Seems there was a bit of a bug or I was doing it a stupid way to cause the bug. got rid of the error checking for the line (12 lines of code) and just replaced i with nentselp to select the longer side of the line left when trimmed. Everything should work 100% now.

 

Also if blocks are closer then r vertically this is what will happen.

 

 

;;----------------------------------------------------------------------;;
;; CONNECT BLOCK TO LINE
(defun C:FOO (/ r ss blklst l1 l2 cir p1 p2 l2 cir p3 p4 p5)
  (if (setq r (vlax-ldata-get "radius" "R"))
    (progn)
    (C:SETUP)
  )
  (while (setq ss (ssget '((0 . "INSERT"))))
    (setq blklst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
    (setq blklst  ;sorts blocks right to left bottom to top from insertion pointy
          (mapcar 'cadr
                  (vl-sort blklst
                           '(lambda (a b)
                              (if (equal (cadr (car a)) (cadr (car b)) 1e-6)
                                (< (car (car a)) (car (car b)))
                                (< (cadr (car a)) (cadr (car b)))
                              )
                            )
                  )
          )
    )
    (setq l1 (car (entsel "\nSelect Line: "))) y
    (foreach ent Blklst
      (setq p1 (vlax-get (vlax-ename->vla-object ent) 'InsertionPoint))
      (setq p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object l1) p1))
      (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
      (setq l2 (entlast))
      (entmake (list (cons 0 "CIRCLE") (cons 10 p2) (cons 40 r)))  ;delete first line and change r to hard code radius
      (setq cir (entlast))
      (setvar 'cmdecho 0)
      (command "TRIM" cir "")
      (command (list l1 p2))
      (command (list l2 p2))
      (command "")
      (setvar 'cmdecho 1)
      (entdel cir)
      (setq p3 (polar p2 (+ (angle p1 p2) (/ pi 2)) r))
      (setq p4 (polar p2 (- (angle p1 p2) (/ pi 2)) r))
      (cond
        ((and (equal (car p1) (car p2) 0.001) (> (cadr p1) (cadr p2)))
          (setq l1 (car (nentselp p3)))
        )
        ((and (equal (car p1) (car p2) 0.001) (< (cadr p1) (cadr p2)))
          (setq l1 (car (nentselp p4)))
        )
        ((< (car p1) (car p2))
          (setq l1 (car (nentselp p3)))
        )
        ((> (car p1) (car p2))
          (setq l1 (car (nentselp p4)))
        )
      )
      (entmake (list (cons 0 "ARC") (cons 10 p2) (cons 40 r) (cons 50 (angle p2 p3)) (cons 51 (angle p2 p4))))
    )
  )
  (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 July 20, 2022 by mhupp
cond statement

[Scoutr4]

Thank you.  I tried the code now but still the same problem repeats. 

[mhupp]

lol didn't account for horizontal in the if statement works now.

[Scoutr4]

Works perfectly now. 

[ronjonp]

How about using a block with a wipeout or mask for the arc or chamfer? Then you would not need to trim. ( assuming this is just a graphical thing ).

[Scoutr4]

17 hours ago, mhupp said:

lol didn't account for horizontal in the if statement works now.

I ran into a problem today. During the process, there is no problem in the lower horizontal, but it makes a connection error in the upper horizontal.

@ronjonpI use wipeout inside blocks when drawing. But I do a lot of editing on the connection points while drawing, I need to design a new block for each connection shape and I always have to keep these blocks. If I lose blocks it takes time to recreate.

[mhupp]

Seems the if statement is a little to pierces checking all 15 digits of the X of each point. upgraded it to a conditional with a fuzz distance check. this should fix all the problems now.

[Scoutr4]

30 minutes ago, mhupp said:

Seems the if statement is a little to pierces checking all 15 digits of the X of each point. upgraded it to a conditional with a fuzz distance check. this should fix all the problems now.

Fixed horizontal link upwards error, but now gives this error with 10-15% chance both horizontally and vertically.

[mhupp]

I'm guessing you have modified the code since your using chamfers again? that used 3 points (p3 p4 p5) where the arc used two (p3 p4). link your code and ill fix it.

 

--edit

the conditional needs to link to these two point names.

(setq p3 (polar p2 (+ (angle p1 p2) (/ pi 2)) r)) ;same with arc or chamfer
(setq p# (polar p2 (- (angle p1 p2) (/ pi 2)) r)) ;p4 with arc p5 with chamfer

 

Edited July 20, 2022 by mhupp

[Scoutr4]

 

17 minutes ago, mhupp said:

I'm guessing you have modified the code since your using chamfers again? that used 3 points (p3 p4 p5) where the arc used two (p3 p4). link your code and ill fix it.

 

the code i am using ;

;;----------------------------------------------------------------------;;
;; CONNECT BLOCK TO LINE
(defun C:LDL (/ r ss blklst l1 l2 cir p1 p2 l2 cir p3 p4 p5)
  (if (setq r (vlax-ldata-get "radius" "R"))
    (progn)
    (C:SETUP)
  )
  (while (setq ss (ssget '((0 . "INSERT"))))
    (setq blklst (mapcar '(lambda (x) (list (cdr (assoc 10 (entget x))) x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))))
    (setq blklst  ;sorts blocks right to left bottom to top from insertion pointy
          (mapcar 'cadr
                  (vl-sort blklst
                           '(lambda (a b)
                              (if (equal (cadr (car a)) (cadr (car b)) 1e-6)
                                (< (car (car a)) (car (car b)))
                                (< (cadr (car a)) (cadr (car b)))
                              )
                            )
                  )
          )
    )
    (setq l1 (car (entsel "\nSelect Line: "))) y
    (foreach ent Blklst
      (setq p1 (vlax-get (vlax-ename->vla-object ent) 'InsertionPoint))
      (setq p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object l1) p1))
      (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
      (setq l2 (entlast))
      (entmake (list (cons 0 "CIRCLE") (cons 10 p2) (cons 40 r)))  ;delete first line and change r to hard code radius
      (setq cir (entlast))
      (setvar 'cmdecho 0)
      (command "TRIM" cir "")
      (command (list l1 p2))
      (command (list l2 p2))
      (command "")
      (setvar 'cmdecho 1)
      (entdel cir)
      (setq p3 (polar p2 (+ (angle p1 p2) (/ pi 2)) r))
      (setq p4 (polar p2 (- (angle p1 p2) (/ pi 2)) r))
      (setq p5 (polar p2 (+ (angle p1 p2) pi) r))
      (cond
        ((and (equal (car p1) (car p2) 0.001) (> (cadr p1) (cadr p2)))
          (setq l1 (car (nentselp p3)))
        )
        ((and (equal (car p1) (car p2) 0.001) (< (cadr p1) (cadr p2)))
          (setq l1 (car (nentselp p4)))
        )
        ((< (car p1) (car p2))
          (setq l1 (car (nentselp p3)))
        )
        ((> (car p1) (car p2))
          (setq l1 (car (nentselp p4)))
        )
      )
    (entmake (list (cons 0 "LINE") (cons 10 p3) (cons 11 p5)))
    (entmake (list (cons 0 "LINE") (cons 10 p5) (cons 11 p4)))
    )
  )
  (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))
  )
)