Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Break & Fillet & Join A Polyline/Line

11 REPLIES 11
SOLVED
Reply
Message 1 of 12
emreakyazicigsl
1181 Views, 11 Replies

Break & Fillet & Join A Polyline/Line

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.

 

emreakyazicigsl_0-1634923239915.png

 

Labels (6)
11 REPLIES 11
Message 2 of 12

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)
)
Message 3 of 12

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.

Message 4 of 12
Sea-Haven
in reply to: emreakyazicigsl

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)

 

Message 5 of 12

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.

Message 6 of 12
emreakyazicigsl
in reply to: Sea-Haven

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:

emreakyazicigsl_0-1635070682329.png

 

---

Figure2:

emreakyazicigsl_1-1635070723108.png

 

Message 7 of 12


@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)

Message 8 of 12
Sea-Haven
in reply to: emreakyazicigsl

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)
Message 9 of 12

I see. Thank you so much. I'm so grateful.
Message 10 of 12
emreakyazicigsl
in reply to: Sea-Haven

In here, I need to use OSNAP ON, at least while determining the pick point/specify point. Also plines are not joined after the process and sometimes it breaks according to radius all lines and not fillet them.
Message 11 of 12
Sea-Haven
in reply to: emreakyazicigsl

Post sample dwg that did not work.

Message 12 of 12
emreakyazicigsl
in reply to: Sea-Haven

I didn't understand what you mean 😞

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost