Is there a lisp program that when select two lines that are crosing simply make an arc in one of line? I know that there is a lisp program that make gap but I need arc.
Crossing two lines with arc
There have been several here recently. Try Searching, here and in the basic AutoCAD Forum.
Kent Cooper, AIA 
Accepted solution
Here you have it. Works only with polylines (plines).
(defun c:wire_jumper( / LM:intersections pick_poly take take2 pointlist2d pl plo pt cir co intlist di tmp ang coords i radius);
;Author: hak_vz
; Monday, September 6, 2021
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;Posted at
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/crossing-two-lines-with-arc/td-p/10602471
;Creates arced wire jumper at intersection between two wires
(defun LM:intersections ( ob1 ob2 mod / lst rtn )
(if (and (vlax-method-applicable-p ob1 'intersectwith)
(vlax-method-applicable-p ob2 'intersectwith)
(setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
)
(repeat (/ (length lst) 3)
(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
lst (cdddr lst)
)
)
)
(reverse rtn)
)
(defun pick_poly ()
(setq e (car(entsel "\nSelect polyline >")))
(if (and (not e) (= (getvar 'Errno) 7)) (pick_poly) e)
)
(setq radius 2); change this according to your preference
(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
(defun take2 (lst) (take 2 lst))
(defun pointlist2d (lst / ret) (while lst (setq ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
(setq pl (pick_poly))
(setq plo (vlax-ename->vla-object pl))
(setq pt (vlax-curve-getclosestpointto pl (getpoint "\nSelect wire jumper intersection point >")))
(setq cir(entmakex (list (cons 0 "CIRCLE") (cons 10 pt) (cons 40 radius))))
(setq co (vlax-ename->vla-object cir))
(setq intlist (mapcar 'take2 (LM:intersections co plo acextendboth)))
(setq coords (append (pointlist2d(vlax-get plo 'Coordinates)) intlist))
(vlax-release-object co)
(entdel cir)
(foreach c coords
(setq di (vlax-curve-getDistAtPoint plo c))
(setq tmp (cons (append (list di) c) tmp))
)
(setq coords (mapcar 'cdr (vl-sort tmp '(lambda (x y) (< (car x)(car y))))))
(vlax-put plo 'Coordinates (apply 'append coords))
(setq coords (pointlist2d(vlax-get plo 'Coordinates)))
(setq test T i -1)
(setq intlist (vl-sort intlist (lambda (x y) (< (vlax-curve-getDistAtPoint plo x) (vlax-curve-getDistAtPoint plo y)))))
(while test
(setq i (1+ i))
(if (= (distance (nth i coords) (car intlist)) 0.0) (setq test nil))
)
(setq ang (+ (angle (car intlist)(cadr intlist)) (/ pi 2.0)))
(setq pt (take2 (polar pt ang radius)))
(cond
((or
(< (angle (car intlist) (cadr intlist)) (/ PI 2))
(> (angle (car intlist) (cadr intlist)) (* 1.5 PI))
)
(vla-SetBulge plo i -1.0)
)
(T (vla-SetBulge plo i 1.0) )
)
(princ)
)Change arc radius value according to your preference.
(setq radius 2); change this according to your preference
Since you are new member to this forum, if this solves your request, accept this as a solution (green button Accept).
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@hak_vz that is perfect solution to my problem thank you. One improvement to that routine can be done I think. Would it be posible to create several arcs when there is a few other intersection at one time?
I'll try to implement this during the next few days if I find some time to spend on it. Option would be to pick intersection points along single polyline, or to automatically create arcs at all intersections. I have created this code to work on single intersection so if user pick wrong polyline its easier to undo.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@Anonymous wrote:
Would it be posible to create several arcs when there is a few other intersection at one time?
Here's an oldie.
(defun c:arcit ( / *error* _inters arc objs pts dir ang)
(vl-load-com)
(defun _Inters (ss / en pts ss en pts)
(repeat (sslength ss)
(setq en (cons (vlax-ename->vla-object (ssname ss 0)) en))
(ssdel (ssname ss 0) ss)
)
(while en
(setq pt (car en))
(mapcar '(lambda (p l / l pt_)
(while l (if (setq v (vlax-invoke p
'IntersectWith (car l)
acExtendNone ))
(repeat (/ (length v) 3)
(setq pt_ (list (car v) (cadr v) (caddr v))
v (member (nth 3 v) v)
)
(if (and pt_ (not (vl-position pt_ pts)))
(setq pts (cons pt_ pts)))))
(setq l (cdr l))))
(list pT)
(list (setq en (vl-remove pt en)))
)
) pts
)
(defun Arc (cen rad sAng eAng)
(entmakex (list (cons 0 "ARC") (cons 10 cen)
(cons 40 rad) (cons 50 sAng)
(cons 51 eAng))))
(setq objs (ssget ":L" '((0 . "*LINE"))))
(setq pts (_inters objs))
(setq rad (if (not rad) 1.0 rad))
(setq rad (cond
((getdist (strcat "\nEnter distance"
(if rad (strcat " <" (rtos rad) ">: ") ": ")
)))(rad)))
(initget 1 "H V")
(setq dir (getkword "\nEnter Option:/ Horizontal/Vertical]: "))
(setq ang (if (eq dir "H")
'(0 pi)
'((/ pi 2.0) (* pi 1.5))
)
)
(foreach p pts
(command-s "_break" "_non"
(polar p (setq fa (eval (car ang))) rad) "_non"
(polar p (setq ea (eval (cadr ang))) rad)
)
(setq carc (arc p rad fa ea))
)
(princ)
)HTH
@pbejseNot bad but it misses some stuff IMO. It only works in horizontal and vertical direction and breaks polyline with separate arc. Plus side is that it works with lines
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Your programe failed, You see the snapshot.gif attached, here.
(setq intlist (vl-sort intlist
(lambda (x y)???
(< (vlax-curve-getDistAtPoint plo x)
(vlax-curve-getDistAtPoint plo y)
)
)
)
)
Accepted solution
@diagodose2009Yes you're right, I've missed quote symbol in front of lambda function. At home I don' use Acad and this software don't require using lambda function without quote. Here is edited code. Thanks.
(defun c:wire_jumper( / LM:intersections pick_poly take take2 pointlist2d pl plo pt cir co intlist di tmp ang coords i radius);
;Author: hak_vz
; Monday, September 6, 2021
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;Posted at
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/crossing-two-lines-with-arc/td-p/10602471
;Creates arced wire jumper at intersection between two wires
(defun LM:intersections ( ob1 ob2 mod / lst rtn )
(if (and (vlax-method-applicable-p ob1 'intersectwith)
(vlax-method-applicable-p ob2 'intersectwith)
(setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
)
(repeat (/ (length lst) 3)
(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
lst (cdddr lst)
)
)
)
(reverse rtn)
)
(defun pick_poly ()
(setq e (car(entsel "\nSelect polyline >")))
(if (and (not e) (= (getvar 'Errno) 7)) (pick_poly) e)
)
(setq radius 2); change this according to your preference
(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
(defun take2 (lst) (take 2 lst))
(defun pointlist2d (lst / ret) (while lst (setq ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
(setq pl (pick_poly) e nil)
(setq plo (vlax-ename->vla-object pl))
(setq pt (vlax-curve-getclosestpointto pl (getpoint "\nSelect wire jumper intersection point >")))
(setq cir(entmakex (list (cons 0 "CIRCLE") (cons 10 pt) (cons 40 radius))))
(setq co (vlax-ename->vla-object cir))
(setq intlist (mapcar 'take2 (LM:intersections co plo acextendboth)))
(setq coords (append (pointlist2d(vlax-get plo 'Coordinates)) intlist))
(vlax-release-object co)
(entdel cir)
(foreach c coords
(setq di (vlax-curve-getDistAtPoint plo c))
(setq tmp (cons (append (list di) c) tmp))
)
(setq coords (mapcar 'cdr (vl-sort tmp '(lambda (x y) (< (car x)(car y))))))
(vlax-put plo 'Coordinates (apply 'append coords))
(setq coords (pointlist2d(vlax-get plo 'Coordinates)))
(setq test T i -1)
(setq intlist (vl-sort intlist '(lambda (x y) (< (vlax-curve-getDistAtPoint plo x) (vlax-curve-getDistAtPoint plo y)))))
(while test
(setq i (1+ i))
(if (= (distance (nth i coords) (car intlist)) 0.0) (setq test nil))
)
(setq ang (+ (angle (car intlist)(cadr intlist)) (/ pi 2.0)))
(setq pt (take2 (polar pt ang radius)))
(cond
((or
(< (angle (car intlist) (cadr intlist)) (/ PI 2))
(> (angle (car intlist) (cadr intlist)) (* 1.5 PI))
)
(vla-SetBulge plo i -1.0)
)
(T (vla-SetBulge plo i 1.0) )
)
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Accepted solution
And here is automated version to process multiple wires. In each next iteration omit i.e. don't select wire or wires that were processed in previous iteration since intersections with that polyline were used in previous iterations.
For single intersection point check post number 9 for updated code.
(defun c:wj2
( / *error* LM:intersections pick_poly take take2 pointlist2d pl plo pt cir co intlist
base_int obj di tmp ang coords i radius il adoc
)
;Author: hak_vz
; Monday, September 6, 2021
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;Posted at
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/crossing-two-lines-with-arc/td-p/10602471
;Creates arced wire jumper at intersection between two or more wires
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ)
)
(if (and adoc) (vla-endundomark adoc))
(princ)
)
(defun LM:intersections ( ob1 ob2 mod / lst rtn )
(if (and (vlax-method-applicable-p ob1 'intersectwith)
(vlax-method-applicable-p ob2 'intersectwith)
(setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
)
(repeat (/ (length lst) 3)
(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
lst (cdddr lst)
)
)
)
(reverse rtn)
)
(defun pick_poly ()
(setq e (car(entsel "\nSelect polyline >")))
(if (and (not e) (= (getvar 'Errno) 7)) (pick_poly) e)
)
(setq radius 2); change this according to your preference
(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
(defun take2 (lst) (take 2 lst))
(defun pointlist2d (lst / ret) (while lst (setq ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark adoc)
(vla-startundomark adoc)
(princ "\nSelect all polylines intersecting with polyline that has wire jumpers > ")
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(setq pl (pick_poly))
(if (ssmemb pl ss)(setq ss(ssdel pl ss)))
(setq plo (vlax-ename->vla-object pl))
(setq i -1)
(setq base_int nil)
(while (< (setq i (1+ i)) (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss i)))
(setq intlist (mapcar 'take2 (LM:intersections plo obj acextendnone)))
(setq base_int (cons intlist base_int))
)
(setq base_int (apply 'append base_int))
(setq base_int (vl-sort base_int '(lambda (x y) (< (vlax-curve-getDistAtPoint plo x) (vlax-curve-getDistAtPoint plo y)))))
(foreach pt base_int
(setq cir(entmakex (list (cons 0 "CIRCLE") (cons 10 pt) (cons 40 radius))))
(setq co (vlax-ename->vla-object cir))
(setq il (LM:intersections co plo acextendnone))
(vlax-release-object co)
(entdel cir)
(cond
((and il)
(setq intlist (mapcar 'take2 il))
(setq coords (append (pointlist2d(vlax-get plo 'Coordinates)) intlist))
(foreach c coords
(setq di (vlax-curve-getDistAtPoint plo c))
(setq tmp (cons (append (list di) c) tmp))
)
(setq coords (mapcar 'cdr (vl-sort tmp '(lambda (x y) (< (car x)(car y))))))
(setq tmp nil)
(vlax-put plo 'Coordinates (apply 'append coords))
(setq coords (pointlist2d(vlax-get plo 'Coordinates)))
(setq intlist (vl-sort intlist '(lambda (x y) (< (vlax-curve-getDistAtPoint plo x) (vlax-curve-getDistAtPoint plo y)))))
(setq test T i -1)
(while test
(setq i (1+ i))
(if (= (distance (nth i coords) (car intlist)) 0.0) (setq test nil))
)
(cond
((or
(< (angle (car intlist) (cadr intlist)) (/ PI 2))
(> (angle (car intlist) (cadr intlist)) (* 1.5 PI))
)
(vla-SetBulge plo i -1.0)
)
(T (vla-SetBulge plo i 1.0) )
)
)
)
)
(vla-endundomark adoc)
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@Anonymous Glad to be of help.
Select last last two code posts as solution, so other users can select working code.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@Sea-Haventhis same problem (2 line chamfer), for same user @ritzofriya, has been solved here on this forum (my solution). @Anonymous has specifically asked for arc to be used.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@Sea-Haven wrote:
Like others there is also a 2 line chamfer answer floating around as well.
Now where is "HOP" the command to run.
Might as well post my contribution
(defun c:iHop ( / _Entnext _inters arc objs breaks pts dir ang ent2Cut el ssc)
;; pBe Sep 2021 ;;;
(setvar 'peditaccept 1)
(vl-load-com)
(defun _Entnext ( e )
(if (setq e (entnext e)) (cons e (_Entnext e)))
)
(defun _Inters (ss / en pts ss en pts)
(repeat (sslength ss)
(setq en (cons (ssname ss 0) en))
(ssdel (ssname ss 0) ss)
)
(while en
(setq pt (car en))
(mapcar '(lambda (p l / l pt_)
(while l (if (setq v (vlax-invoke (vlax-ename->vla-object p)
'IntersectWith (vlax-ename->vla-object (car l))
acExtendNone ))
(repeat (/ (length v) 3)
(setq pt_ (list (car v) (cadr v) (caddr v))
v (member (nth 3 v) v)
)
(if (and pt_ (not (vl-position pt_ pts)))
(setq pts (cons (list pt_ p (car l)) pts)))))
(setq l (cdr l))))
(list pT)
(list (setq en (vl-remove pt en)))
)
) pts
)
(defun Arc (cen rad sAng eAng)
(entmakex (list (cons 0 "ARC") (cons 10 cen)
(cons 40 rad) (cons 50 sAng)
(cons 51 eAng))))
(if
(and
(setq objs (ssget ":L" '((0 . "*LINE"))))
(setq pts (_inters objs))
(setq rad (if (not rad) 1.0 rad))
(setq rad (cond
((getdist (strcat "\nEnter distance"
(if rad (strcat " <" (rtos rad) ">: ") ": ")
)))(rad)))
(princ "\nSelect Lines to break")
(setq breaks (ssget ":L" '((0 . "*LINE"))))
)
(repeat (setq i (sslength breaks))
(setq ent2Cut (ssname breaks (setq i (1- i))))
(setq ang nil el (entlast) ssc (ssadd))
(foreach p pts
(if (member ent2Cut p)
(progn
(or ang (setq ang (angle '(0.0 0.0 0.0)
(vlax-curve-getfirstderiv ent2Cut
(vlax-curve-getparamatpoint ent2Cut (Car p))))))
(command-s "_break" "_non" (polar (car p) ang rad) "_non"
(polar (car p) (setq ea (+ pi ang)) rad))
(arc (Car p) rad ang ea)
(mapcar '(lambda ( x ) (ssadd x ssc)) (_Entnext el))
)
)
)
(command-s "pedit" ent2Cut "j" ssc "" "")
)
)
(princ)
)
HTH
EDIT: Change to multiple selection instead of while