Please help me by giving a lisp code for below function

Please help me by giving a lisp code for below function

ritzofriya
Advocate Advocate
898 Views
15 Replies
Message 1 of 16

Please help me by giving a lisp code for below function

ritzofriya
Advocate
Advocate

Capture.JPG

looking for a program to make the 45Dgr line break. if possible all 4 sides 

0 Likes
Accepted solutions (3)
899 Views
15 Replies
Replies (15)
Message 2 of 16

Kent1Cooper
Consultant
Consultant

I don't understand what you mean by "all 4 sides" -- post an image.

 

If an Arc will do, try >this<.  A Search will probably find more such routines.

Kent Cooper, AIA
0 Likes
Message 3 of 16

Sea-Haven
Mentor
Mentor

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.

 

0 Likes
Message 4 of 16

ritzofriya
Advocate
Advocate

4 side means left right up and down position of the 45dgr lines 

0 Likes
Message 5 of 16

hak_vz
Advisor
Advisor
Accepted solution

@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

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 6 of 16

hak_vz
Advisor
Advisor

Also attach sample drawing so dimension of V jump can be taken.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 7 of 16

ritzofriya
Advocate
Advocate

its coming arc.. not fillet line 

0 Likes
Message 8 of 16

ritzofriya
Advocate
Advocate

its perfect but how to chose direction?

0 Likes
Message 9 of 16

ritzofriya
Advocate
Advocate

how can i adjust the fillet height? its too small for my dwg.

0 Likes
Message 10 of 16

hak_vz
Advisor
Advisor

 


@ritzofriya wrote:

its perfect but how to chose direction?


@ritzofriya 

 

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

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 11 of 16

ritzofriya
Advocate
Advocate

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 🙂

0 Likes
Message 12 of 16

hak_vz
Advisor
Advisor

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

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 13 of 16

ritzofriya
Advocate
Advocate
Accepted solution

now we lose the shape 

STD shape ss attached for your reference 

the 90Dgr angle is most important else can vary +/- 10%

Capture.JPG

0 Likes
Message 14 of 16

hak_vz
Advisor
Advisor
Accepted solution

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

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 15 of 16

Sea-Haven
Mentor
Mentor

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.

 

SeaHaven_0-1628999538942.png

 

Message 16 of 16

ritzofriya
Advocate
Advocate

This is perfect for me... Thanks a lot dear