Hello everyone, I was looking for a LISP that breaks a polyline (if possible line/polyline both) with a distance 5 in both size, then double fillet with radius 5, creates 2 overlapped segments and joins them all by specifying a point and applied polyline should be closest one (if possible). If the command is proper to repeat or multiple selection, it would be much more amazing.
I explained in a PNG, I hope it was clear enough and you may help. Thanks.
Solved! Go to Solution.
Solved by CADaSchtroumpf. Go to Solution.
Solved by Sea-Haven. Go to Solution.
Solved by CADaSchtroumpf. Go to Solution.
Briefly tested...
(vl-load-com)
(defun clockwise-p (p1 p2 p3)
(< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
)
(defun add_vtx (obj add_pt ent_name / bulg)
(vla-addVertex
obj
(1+ (fix add_pt))
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 1))
(list
(car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
(cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
)
)
)
)
(setq bulg (vla-GetBulge obj (fix add_pt)))
(vla-SetBulge obj
(fix add_pt)
(/
(sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
(cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
)
)
(vla-SetBulge obj
(1+ (fix add_pt))
(/
(sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
(cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
)
)
(vla-update obj)
)
(defun c:appendix ( / js obj_vla e_name AcDoc pt pto pt_prmt fill_prmt blg)
(while (null (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))))
(princ "\nCe n'est pas un objet valable!")
)
(setq obj_vla (vlax-ename->vla-object (setq e_name (ssname js 0))) AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(sssetfirst nil js)
(while (setq pt (getpoint "\nLocation of new vertex: "))
(setq
pto (vlax-curve-getClosestPointTo obj_vla (trans pt 1 0))
pt_prmt (vlax-curve-getparamatpoint obj_vla pto)
fill_prmt (vlax-curve-getdistatparam obj_vla pt_prmt)
)
(if (clockwise-p (vlax-curve-getpointatparam obj_vla (vlax-curve-getparamatdist obj_vla (- fill_prmt 1))) pto (trans pt 1 0))
(setq blg (- (1- (sqrt 2))))
(setq blg (1- (sqrt 2)))
)
(add_vtx obj_vla (vlax-curve-getparamatdist obj_vla (- fill_prmt 5)) e_name)
(add_vtx obj_vla (vlax-curve-getparamatdist obj_vla (+ fill_prmt 5)) e_name)
(vla-SetBulge obj_vla (1+ (fix pt_prmt)) blg)
(vla-update obj_vla)
(mapcar
'(lambda (p r / )
(vla-addVertex
obj_vla
(+ r (fix pt_prmt))
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 1))
(list
(car (trans (trans p 1 0) 0 e_name))
(cadr (trans (trans p 1 0) 0 e_name))
)
)
)
)
(vla-update obj_vla)
)
(list (polar pto (angle pto (trans pt 1 0)) 5) pt (polar pto (angle pto (trans pt 1 0)) 5))
(list 2 3 4)
)
(vla-SetBulge obj_vla (+ 4 (fix pt_prmt)) blg)
(vla-update obj_vla)
(sssetfirst nil js)
)
(sssetfirst)
(vla-EndUndoMark AcDoc)
(prin1)
)
It looks almost perfect. Thanks for your help. I noticed that it creates the new segment from the closest part of pline, when I apply the command once, it may result some problems 2nd application. It takes from the closest segment and I need to take from original part, if 1st application is closer than my source pline, I cannot use command in that case.
As I said, it's incredibly amazing and thank you so much, if this situation is able to handle, it would be stunning. Thank you so much.
This is a bit buggy will sort it out if a line then works 1st go. Fishing got in the way.
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/break-amp-fillet-amp-join-a-polyline-line/td-p/10707334
(defun c:dbl5 ( / rad oldsnap pt pt2 ent1 ent2 ent3 ent4 ent5 obj obj2)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq rad 5.0)
(setq pt (getpoint "\nPick point"))
(setq ent1 (entsel "Pick p/Line "))
(setq obj (vlax-ename->vla-object (car ent1 )))
(if (= (vla-get-objectname obj) "AcDbPolyline")
(progn
(command "explode" ent1 )
(setq ent1 (entlast))
(setq obj (vlax-ename->vla-object ent1))
)
)
(setq pt2 (vlax-curve-getclosestpointto obj pt))
(command "circle" pt2 rad)
(setq ent2 (entlast))
(setq obj2 (vlax-ename->vla-object ent2))
(setq pts (vlax-invoke obj 'intersectWith obj2 acExtendnone))
(entdel (entlast))
(setq pt2 (polar pt (angle pt pt2 )(- (distance pt pt2) rad)))
(command "PLINE" pt pt2 "")
(setq ent3 (entlast))
(command "PLINE" pt pt2 "")
(setq ent4 (entlast))
(command "Break" (list (nth 0 pts)(nth 1 pts))(list (nth 3 pts)(nth 4 pts)))
(setq ent5 (entlast))
(setvar 'filletrad rad)
(command "fillet" ent3 ent1)
(command "fillet" ent4 ent5)
(setvar 'osmode oldsnap)
(princ)
)
(c:dbl5)
It's so good thank you so much. Is there a way to apply this command with osnap on, while selecting my pick point/specify point? Also can I use that with repetition? If I'm able to apply this command with both, that would be flawless. Thank you so much for this LISP.
I noticed that there are some bugs in application. plines are not completely joined (Figure1) and sometimes I'm losing segments of plines (Figure2) as you can see in PNGs.
Figure1:
---
Figure2:
@emreakyazicigsl a écrit :It looks almost perfect. Thanks for your help. I noticed that it creates the new segment from the closest part of pline, when I apply the command once, it may result some problems 2nd application. It takes from the closest segment and I need to take from original part, if 1st application is closer than my source pline, I cannot use command in that case.
As I said, it's incredibly amazing and thank you so much, if this situation is able to handle, it would be stunning. Thank you so much.
To avoid the search for the closest points on the appendages created, we can make a copy of the original polyline on which we will execute the function (vlax-curve-getClosestPointTo) and delete it at the end of the procedure.
So the closest points will always be on the original polyline.
It is the simplest solution it seems to me.
Please note that the function also works on polyline arcs.
I added the introduction of the value of the fillet as well as the impossible cases (I certainly forgot some)
Redid it taking into account multiple pick
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/break-amp-fillet-amp-join-a-polyline-line/td-p/10707334
(defun c:dbl5 ( / rad oldsnap pt pt2 ent1 ent2 ent3 ent4 ent5 obj obj2)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq rad 5.0)
(setq pt (getpoint "\nPick point"))
(setq ent1 (entsel "Pick p/Line "))
(setq obj (vlax-ename->vla-object (car ent1 )))
(if (= (vla-get-objectname obj) "AcDbline")
(progn
(command "Pedit" ent1 "Y" "" )
(setq ent1 (entlast))
(setq obj (vlax-ename->vla-object ent1))
)
)
(setq pt2 (vlax-curve-getclosestpointto obj pt))
(command "circle" pt2 rad)
(setq ent2 (entlast))
(setq obj2 (vlax-ename->vla-object ent2))
(setq pts (vlax-invoke obj 'intersectWith obj2 acExtendnone))
(entdel (entlast))
(setq pt2 (polar pt (angle pt pt2 )(- (distance pt pt2) rad)))
(command "Break" (list (nth 0 pts)(nth 1 pts))(list (nth 3 pts)(nth 4 pts)))
(setq ent5 (entlast))
(command "LINE" pt pt2 "")
(setq ent3 (entlast))
(command "LINE" pt pt2 "")
(setq ent4 (entlast))
(setvar 'filletrad rad)
(command "fillet" "_near" (list (nth 0 pts)(nth 1 pts)) ent3)
(command "fillet" "_near" (list (nth 3 pts)(nth 4 pts)) ent4)
(setvar 'osmode oldsnap)
(princ)
)
(c:dbl5)
Can't find what you're looking for? Ask the community or share your knowledge.