Jump to content

Fillet multiple lines/polylines in separate layers.

Temy

By Temy
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Temy Apprentice

Temy

Posted
Posted

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

For example.dwg

dlanorh Mentor

dlanorh

Posted
Posted (edited)

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
Temy Apprentice

Temy

Posted
  • Author
Posted
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

BIGAL Grand Master

BIGAL

Posted
Posted

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

 

 

 

  • Like 2
dlanorh Mentor

dlanorh

Posted
Posted
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
Temy Apprentice

Temy

Posted
  • Author
Posted

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

For example2.dwg

BIGAL Grand Master

BIGAL

Posted
Posted

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
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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
Temy Apprentice

Temy

Posted
  • Author
Posted

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

dlanorh Mentor

dlanorh

Posted
Posted (edited)

@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
Temy Apprentice

Temy

Posted
  • Author
Posted (edited)
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
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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
dlanorh Mentor

dlanorh

Posted
Posted
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
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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
PeterPan9720 Collaborator

PeterPan9720

Posted
Posted

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

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
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
Go to topic listing
×
×
  • Create New...