This is being answered else where as well, Can anyone help me to make a LISP to make below Action - AutoLISP, Visual LISP & DCL - AutoCAD Forum...
The hop function can be amended to suit that was suggested.
4 side means left right up and down position of the 45dgr lines
@ritzofriya Try this
(defun c:wire_jumper( / LM:intersections pick_poly take take2 pointlist2d pl plo pt cir co intlist coords di tmp ang)
;Author: hak_vz 14.08.2021
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;
;posted at https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/please-help-me-by-giving-a-lisp-code-for-below-function/td-p/10534078
;Creates wire jumper at intersection between two wires
;Works only on streigth polylines
(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)
)
(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 2))))
(setq co (vlax-ename->vla-object cir))
(setq intlist (mapcar 'take2 (LM:intersections co plo acextendboth)))
(entdel cir)
(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))))))
(vlax-put plo 'Coordinates (apply 'append coords))
(setq tmp (pointlist2d(vlax-get plo 'Coordinates)))
(setq coords (list))
(while (<(vlax-curve-getDistAtPoint plo (car tmp))(vlax-curve-getDistAtPoint plo pt))
(setq coords (append coords (car tmp)) tmp (cdr tmp))
)
(setq ang (+ (angle (car intlist)(cadr intlist)) (/ pi 2.0)))
(setq pt (take2 (polar pt ang 2)))
(setq coords (append coords pt))
(setq coords (append coords (apply 'append tmp)))
(vlax-put plo 'Coordinates coords)
(princ)
)
Next time. when giving name to the request title, try to define it so it's searchable to other users with similar request. "Please help me by giving a lisp code for below function" is not searchable.
Miljenko Hatlak
Also attach sample drawing so dimension of V jump can be taken.
Miljenko Hatlak
its coming arc.. not fillet line
its perfect but how to chose direction?
how can i adjust the fillet height? its too small for my dwg.
@ritzofriya wrote:its perfect but how to chose direction?
Code works in following way. At the intersection point it temporary creates a circle and finds its intersection with polyline. Two intersection points are added to polyline coordinates, and third in middle of this two points in a direction perpendicular to line connecting them i.e adding 90 deg to angle. Depending on how polyline is created (left to right or opposite it may end in different direction). Adding option to select direction is not an easy task as this code wasn't easy to code since it has lots of coordinate manipulations without splitting polyline.
I may add this in later changes in accordance to your replies. When posting a request try to give as much information you can to help us write the code, attach sample drawing if possible (image is OK but without shown dimensions its of no help).
What's more important:
a) What are dimensions of this "wire jumper" you regularly use in your drawings ?
b) Do you create this changes along one polyline at a time or pick positions at random selection (for possible automation)
Miljenko Hatlak
What's more important:
a) What are dimensions of this "wire jumper" you regularly use in your drawings ?
Ans: Exactly scale with scale factor 100 (100times bigger) then your current program (i m using mm units)
b) Do you create this changes along one polyline at a time or pick positions at random selection (for possible automation)
Ans: looking for automatic jumper in all intersection in single selection ,if possible 🙂
Here is updated code that at first run it asks you to enter wire jumper width and it uses it later on. It is a distance between two triangle base points laying on polyline. If you want to change it run command WIRE_JUMPER_INIT. I have to think about possible automation and option to choose direction (not an easy task IMO). Will try to make it through the weekend. Have already spent some two hours on codding and editing before creating this we have now.
Since direction option is hard to code, what would preferred direction i.e. up and left or something else?
(defun wire_jumper_init ()
(setq wire_jumper_width (getreal "\nEnter wire jumper width >"))
(princ)
)
(defun c:wire_jumper_init ()
(wire_jumper_init)
)
(defun c:wire_jumper( / *error* LM:intersections pick_poly take take2 pointlist2d pl plo pt cir co intlist coords di tmp ang)
;Author: hak_vz
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;
;Creates wire jumper at intersection between two wires
;Works only on streigth polylines
(defun *error* (msg)
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
(progn
(princ (strcat "\nOops an Error : ( " msg " ) occurred."))
)
)
(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)
)
(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))
(if (not wire_jumper_width) (wire_jumper_init))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark adoc)
(vla-startundomark adoc)
(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 (* 0.5 wire_jumper_width)))))
(setq co (vlax-ename->vla-object cir))
(setq intlist (mapcar 'take2 (LM:intersections co plo acextendboth)))
(entdel cir)
(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))))))
(vlax-put plo 'Coordinates (apply 'append coords))
(setq tmp (pointlist2d(vlax-get plo 'Coordinates)))
(setq coords (list))
(while (<(vlax-curve-getDistAtPoint plo (car tmp))(vlax-curve-getDistAtPoint plo pt))
(setq coords (append coords (car tmp)) tmp (cdr tmp))
)
(setq ang (+ (angle (car intlist)(cadr intlist)) (/ pi 2.0)))
(setq pt (take2 (polar pt ang (* 0.5 (sin (/ PI 2.0)) wire_jumper_width))))
(setq coords (append coords pt))
(setq coords (append coords (apply 'append tmp)))
(vlax-put plo 'Coordinates coords)
(vla-endundomark adoc)
(princ)
)
CODE HAS BEEN UPDATED ACCORDING TO POST NO 13
Miljenko Hatlak
now we lose the shape
STD shape ss attached for your reference
the 90Dgr angle is most important else can vary +/- 10%
Code above is updated. This image gives a lot more info. Please append according my previous post regarding direction.
Thanks to 30 minutes post edit limit here is final code.
(defun wire_jumper_init ()
(setq wire_jumper_width (getreal "\nEnter wire jumper width >"))
(princ)
)
(defun c:wire_jumper_init ()
(wire_jumper_init)
)
(defun c:wire_jumper( / *error* LM:intersections pick_poly take take2 pointlist2d pl plo pt cir co intlist coords di tmp ang)
;Author: hak_vz
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;
;Creates wire jumper at intersection between two wires
;Works only on streigth polylines
(defun *error* (msg)
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
(progn
(princ (strcat "\nOops an Error : ( " msg " ) occurred."))
)
)
(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)
)
(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))
(if (not wire_jumper_width) (wire_jumper_init))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark adoc)
(vla-startundomark adoc)
(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 (* 0.5 wire_jumper_width)))))
(setq co (vlax-ename->vla-object cir))
(setq intlist (mapcar 'take2 (LM:intersections co plo acextendboth)))
(entdel cir)
(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))))))
(vlax-put plo 'Coordinates (apply 'append coords))
(setq tmp (pointlist2d(vlax-get plo 'Coordinates)))
(setq coords (list))
(while (<(vlax-curve-getDistAtPoint plo (car tmp))(vlax-curve-getDistAtPoint plo pt))
(setq coords (append coords (car tmp)) tmp (cdr tmp))
)
(setq ang (+ (angle (car intlist)(cadr intlist)) (/ pi 2.0)))
(setq pt (take2 (polar pt ang (* 0.5 (sin (/ PI 2.0)) wire_jumper_width))))
(setq coords (append coords pt))
(setq coords (append coords (apply 'append tmp)))
(vlax-put plo 'Coordinates coords)
(vla-endundomark adoc)
(princ)
)
Miljenko Hatlak
Peed posters to acknowledge mutliple posts on different forums.
A different version is at https://www.cadtutor.net/forum/topic/73466-can-anyone-help-me-to-make-a-lisp-to-make-below-action/ could add flip direction choice.
The automation is a problem not from find a line crossing but which direction ? Hence my original drag or pick 2 objects 1st is hop 2nd is direction.
This is perfect for me... Thanks a lot dear