Fillet multiple lines/polylines in separate layers.

May 6, 2020

Hi all,

I want to fillet multiple lines at once, but it has to be one layer, Something similar to the image I have attached below.

can somebody help me please?

thanks

For example.dwg

May 6, 2020

In a basic form try this

(defun c:fbl ( / fr ent lyr pea rad ss a )
  (setq fr (getvar 'filletrad)
        ent (car (entsel "\nSelect Object on layer to fillet : "))
        lyr (cdr (assoc 8 (entget ent)))
  )
  (cond ( (not (= 1 (getvar 'peditaccept))) (setq pea (getvar 'peditaccept)) (setvar 'peditaccept 1)))
  (initget 6)
  (setq rad (cond ( (getreal (strcat "\nEnter Fillet Radius <" (rtos fr) "> : "))) (fr)))
  (if (/= rad fr) (setvar 'filletrad rad))
  
  (setq ss (ssget (list (cons 8 lyr)))
        a (ssname ss 0)
  )
  (command "pedit" a "_J" ss "" "")
  (setq ent (entlast))
  (command "fillet" "_P" ent)
  (command "explode" ent)
  (if pea (setvar 'peditaccept pea))
  (setvar 'filletrad fr)
  (princ)
)

Edited May 11, 2020 by dlanorh
updated code

May 11, 2020

On 5/6/2020 at 4:51 PM, dlanorh said:

In a basic form try this


(defun c:fbl ( / fr ent lyr rad ss a )
  (setq fr (getvar 'filletrad)
        ent (car (entsel "\nSelect Object on layer to fillet : "))
        lyr (cdr (assoc 8 (entget ent)))
  )
  (initget 6)
  (setq rad (cond ( (getreal (strcat "\nEnter Fillet Radius <" (rtos fr) "> : "))) (fr)))
  (if (/= rad fr) (setvar 'filletrad rad))
  
  (setq ss (ssget (list (cons 8 lyr)))
        a (ssname ss 0)
  )
  (command "pedit" a "_J" ss "" "")
  (setq ent (entlast))
  (command "fillet" "_P" ent)
  (command "explode" ent)
  (setvar 'filletrad fr)
  (princ)
)

Thanks very much.

I tried it, but it has a problem. Please help me fix it.

May 11, 2020

Dlanorh seemed to fix (command "pedit" (ssname ss 0) "_y" "_J" ss "" "") missing convert to pline yes

May 11, 2020

1 hour ago, Temy said:

Thanks very much.

I tried it, but it has a problem. Please help me fix it.

Apologies. This is a system variable problem (peditaccept). I have altered the code in my original post to account for this, or you can go with @BIGAL approach and replace the command call in my code with his.

May 11, 2020

It works great, Thanks very much!

May 11, 2020

I'm sorry, With this lisp I have accepted it however I want it to be more complete for me. please help me again. thanks!

For example2.dwg

May 12, 2020

So you want pick all layers then do it ?

(defun c:fbl ( / fr ent lyr rad ss a lst)
(setq lst '())
  (setq fr (getvar 'filletrad))
  (setvar 'orthomode 0)
  (initget 6)
  (setq rad (cond ( (getreal (strcat "\nEnter Fillet Radius <" (rtos fr) "> : "))) (fr)))
  (if (/= rad fr) (setvar 'filletrad rad))
(while (setq ent (car (entsel "\nSelect Object on layer to fillet : ")))
       (setq  lst (cons (cdr (assoc 8 (entget ent))) lst))
)
  (setq pt1 (getpoint "Pick corner pt1"))
  (setq pt2 (getpoint pt1 "Pick corner pt2"))
  (repeat (setq x (length lst))
  (setq lay (nth (setq x (- x 1)) lst))
  (setq ss (ssget "w" pt1 pt2 (list (cons 8 lay))))
  (command "pedit" (ssname ss 0) "_y" "_J" ss "" "")
  (setq ent (entlast))
  (command "fillet" "_P" ent)
  )
  (setvar 'filletrad fr)
  (princ)
)

May 12, 2020

Version 3.

I need some help I know its a mapcar task but that's something I am not real good at. I have in past just used a get next and does not match, I am sure its been answered before but could not find.

So I have a list ((layer entityname)(layer entityname)(layer entityname) ..)

What I want is ((entityname entityname….)(entityname ….)(entityname ….)) so for this task have 3 layers and 14 entities the new list is 3 items entities by layer name

(("0" <Entity name: 2279faf91f0>) ("0" <Entity name: 2279faf91e0>) ("0" <Entity name: 2279faf91d0>)………...

(defun c:fbl2 ( / fr ent lyr rad ss a lst)
(setq lst '())
  (setq fr (getvar 'filletrad))
  (initget 6)
  (setq rad (cond ( (getreal (strcat "\nEnter Fillet Radius <" (rtos fr) "> : "))) (fr)))
  (if (/= rad fr) (setvar 'filletrad rad))

(setq ss (ssget '((0 . "LINE"))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq lay (cdr (assoc 8 (entget  ent))))
(setq lst (cons (list lay ent)  lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
; need new list here
; (foreach newlist make plines and fillet
)

Edited May 12, 2020 by BIGAL

May 12, 2020

Thank you for your kind help! I tried modifying and it worked, but don't know if it works well or not. Check it out and Can you extend the functionality for me?

(defun c:fbl2 ( / fr ent lyr dxf in rad ss a lst)
(setq lst '())
  (setq fr (getvar 'filletrad))
  (initget 6)
  (setq rad (cond ( (getreal (strcat "\nEnter Fillet Radius <" (rtos fr) "> : "))) (fr)))
  (if (/= rad fr) (setvar 'filletrad rad))
  (defun dxf (n o) (cdr (assoc n (entget o))))
  (if (setq ss (ssget "_:L" '((0 . "LINE"))))
    (progn
      (repeat (setq in (sslength ss))
        (setq lst (cons (ssname ss (setq in (1- in))) lst))
      )
      (foreach e lst
        (foreach ent lst
          (if (or (equal (dxf 10 e) (dxf 10 ent) 1e-8)
                  (equal (dxf 11 e) (dxf 10 ent) 1e-8)
                  (equal (dxf 11 e) (dxf 11 ent) 1e-8)
                  (equal (dxf 10 e) (dxf 11 ent) 1e-8)
              )
            (command "_.fillet" e ent)
          )
        )
      )
    )
  )
  (princ)
)

I hope to receive more help from yous!

May 12, 2020

@Temy Tested and working. I think it covers every case so far. It utilises the dynamic prompt for the All/Select prompt default is All so a right click or enter will select the default.

Default for fillet radius is the current fillet radius as before.

(defun c:fbl ( / *error* c_doc sv_lst sv_vals fr fuzz typ rad filter ss ssp bx cnt ent lyr)

  (vl-load-com)

  (defun *error* ( msg )
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        sv_lst (list 'cmdecho 'osmode 'peditaccept 'dynmode 'dynprompt 'filletrad)
        sv_vals (mapcar 'getvar sv_lst)
        fr (getvar 'filletrad)
        fuzz 1.0e-6
  );end_setq

  (mapcar 'setvar sv_lst '(0 0 1 3 1))

  (initget "All Select")
  (setq typ (cond ( (getkword "\nProcess All or Selected Layers? : [All/Select] <All>")) ("All")))
  (if (= typ "Select") (setq ent (car (entsel "\nSelect Object on layer to fillet : ")) lyr (cdr (assoc 8 (entget ent)))))

  (initget 6)
  (setq rad (cond ( (getreal (strcat "\nEnter Fillet Radius <" (rtos fr) "> : "))) (fr)))
  (if (/= rad fr) (setvar 'filletrad rad))

  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

  (if (= typ "Select") (setq filter (list '(0 . "LINE") (cons 8 lyr))) (setq filter (list '(0 . "LINE"))))
  (setq ss (ssget ":L" filter))

  (cond (ss
          (command "_.pedit" "_M" ss "" "_J" fuzz "")
          (setq bx (mapcar 'cdr (apply 'append (mapcar 'cdr (vl-remove-if-not '(lambda (x) (minusp (car x))) (ssnamex ss)))))
                ssp (ssget "_WP" (apply 'append bx) '((0 . "LWPOLYLINE")))
                ss nil
          );end_setq
          (repeat (setq cnt (sslength ssp))
            (setq ent (ssname ssp (setq cnt (1- cnt))))
            (command "fillet" "_P" ent)
            (command "explode" ent)
          );end_repeat
        )
  );end_cond

  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

Any problems let me know

Edited May 13, 2020 by dlanorh
code updated

May 13, 2020

19 hours ago, dlanorh said:

@Temy Tested and working. I think it covers every case so far. It utilises the dynamic prompt for the All/Select prompt default is All so a right click or enter will select the default.

Default for fillet radius is the current fillet radius as before.


(defun c:fbl ( / *error* c_doc sv_lst sv_vals fr fuzz typ rad filter ss ssp bx cnt ent lyr)

  (vl-load-com)

  (defun *error* ( msg )
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt 'filletrad)
        sv_vals (mapcar 'getvar sv_lst)
        fr (getvar 'filletrad)
        fuzz 1.0e-6
  );end_setq

  (mapcar 'setvar sv_lst '(0 0 3 1))

  (initget "All Select")
  (setq typ (cond ( (getkword "\nProcess All or Selected Layers? : [All/Select] <All>")) ("All")))
  (if (= typ "Select") (setq ent (car (entsel "\nSelect Object on layer to fillet : ")) lyr (cdr (assoc 8 (entget ent)))))

  (initget 6)
  (setq rad (cond ( (getreal (strcat "\nEnter Fillet Radius <" (rtos fr) "> : "))) (fr)))
  (if (/= rad fr) (setvar 'filletrad rad))

  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

  (if (= typ "Select") (setq filter (list '(0 . "LINE") (cons 8 lyr))) (setq filter (list '(0 . "LINE"))))
  (setq ss (ssget ":L" filter))

  (cond (ss
          (command "_.pedit" "_M" ss "" "_J" fuzz "")
          (setq bx (mapcar 'cdr (apply 'append (mapcar 'cdr (vl-remove-if-not '(lambda (x) (minusp (car x))) (ssnamex ss)))))
                ssp (ssget "_WP" (apply 'append bx) '((0 . "LWPOLYLINE")))
                ss nil
          );end_setq
          (repeat (setq cnt (sslength ssp))
            (setq ent (ssname ssp (setq cnt (1- cnt))))
            (command "fillet" "_P" ent)
            (command "explode" ent)
          );end_repeat
        )
  );end_cond

  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

Any problems let me know

Thank you @dlanorh

I have used and worked well on AutoCAD2008 version, but on AutoCAD2019 version it has a problem.

It reports the following error. please fix it...

Edited May 13, 2020 by Temy
update question

May 13, 2020

Had another go a simpler method using Autocads pedit multiple.

(defun c:fbl3 ( / fr pt1 pt2 ss)
(setq fr (getvar 'filletrad))
(initget 6)
(setq rad (cond ( (getreal (strcat "\nEnter Fillet Radius <" (rtos fr) "> : "))) (fr)))
(if (/= rad fr) (setvar 'filletrad rad))
(setq pt1 (getpoint "\nPick 1st cnr point"))
(setq pt2 (getpoint pt1 "\nPick 1st cnr point"))
(command "Pedit" "m" "w" pt1 pt2 "" "Y" "Join" 0.0 "")
(setq ss (ssget "w" pt1 pt2 '((0 . "LWPOLYLINE"))))
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq pt1 (vlax-curve-getendpoint (vlax-ename->vla-object ent)))
(command "fillet" "P" pt1 )
)
(princ)
)
(c:fbl3)

Edited May 13, 2020 by BIGAL

May 13, 2020

7 hours ago, Temy said:

Thank you @dlanorh

I have used and worked well on AutoCAD2008 version, but on AutoCAD2019 version it has a problem.

It reports the following error. please fix it...

This is probably because the system variable "peditaccept" is different on the two systems. It should be 1. I have altered the posted code in my last post to account for this.

May 13, 2020

Somehow code was not posted updated my last post much shorter code. Pick pt1 say bottom left pick pt2 top right both slightly away form outside object.

Edited May 13, 2020 by BIGAL

May 18, 2020

@BIGAL

Hi, I read this post and probably could solve my issue.

Did you ever used VBA (please no LSP) for fillet two lines (or polylines) ?

I found on Autocad help the following code

Set NewArc = Fillet(Line1, Line2, dRad)

But it's doesn't work with VBA, because seems Fillet command not recognized.

Please somebody could help me ?

Fillet multiple lines/polylines in separate layers.

Recommended Posts

Temy

Link to comment

Share on other sites

dlanorh

Link to comment

Share on other sites

Temy

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

dlanorh

Link to comment

Share on other sites

Temy

Link to comment

Share on other sites

Temy

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Temy

Link to comment

Share on other sites

dlanorh

Link to comment

Share on other sites

Temy

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

dlanorh

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

PeterPan9720

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity