Jump to content

Fillet multiple lines/polylines in separate layers.


Temy
 Share

Recommended Posts

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 by dlanorh
updated code
  • Like 2
Link to comment
Share on other sites

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.

For example1.jpg

Link to comment
Share on other sites

1 hour ago, Temy said:

Thanks very much.

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

For example1.jpg

 

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.

  • Thanks 1
Link to comment
Share on other sites

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

 

  • Like 1
Link to comment
Share on other sites

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 by BIGAL
  • Like 1
Link to comment
Share on other sites

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!

For example3.JPG

Link to comment
Share on other sites

@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 by dlanorh
code updated
  • Thanks 1
Link to comment
Share on other sites

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...

 

 

For example4.jpg

Edited by Temy
update question
Link to comment
Share on other sites

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 by BIGAL
  • Like 1
Link to comment
Share on other sites

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...

 

 

For example4.jpg

 

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.

  • Thanks 1
Link to comment
Share on other sites

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 by BIGAL
  • Like 1
Link to comment
Share on other sites

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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...