Jump to content

one line to many fillet


cooldude

Recommended Posts

I know a version of this question has been as numerous times but i have not found a lisp to fillet many lines to one line. e.g. wires branching from a cable in an electrical drawing. Does anybody have anything like this? I know I can do it with the multiple feature in fillet but I do a lot of lines.

Mult fillet.png

Link to comment
Share on other sites

Or if your lines are not parallel and cross main line, try this lisp...

 

(defun c:filletlines ( / 3d2d v^v unit acos angle3d marc ss i li lil lixl lill p pl ml lilr sp ep p1 p2 rlpl r gr p a ip d v aep1 aep2 li cp dd arc arcl x )

 (vl-load-com)

 (defun 3d2d ( p )
   (mapcar '+ '(0.0 0.0) p)
 )

 (defun v^v ( u v )
   (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
 )

 (defun unit ( v )
   (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
 )

 (defun acos ( x )
   (cond
     ((equal x 1.0 1e- 0.0)
     ((equal x -1.0 1e- pi)
     ((equal x 0.0 1e- (/ pi 2.0))
     ((equal x -0.0 1e- (* 3.0 (/ pi 2.0)))
     ((atan (/ (sqrt (- 1.0 (* x x))) x)))
   )
 )

 (defun angle3d ( p1 por p2 / vec1 vec2 dd ang )
   (setq vec1 (unit (mapcar '- p1 por))
         vec2 (unit (mapcar '- p2 por))
         dd (distance vec1 vec2)
         ang (acos (- 1.0 (/ (expt dd 2) 2.0)))
   )
   (if (minusp ang) (+ ang pi) ang)
 )

 (defun marc ( c p1 p2 / dxf10 dxf40 dxf210 dxf50 dxf51 uz )
   (setq dxf10 (trans c 0 (setq uz (v^v (mapcar '- p1 c) (mapcar '- p2 c)))))
   (setq dxf40 (distance c p1))
   (setq dxf210 (unit uz))
   (setq dxf50 (angle dxf10 (trans p1 0 uz)))
   (setq dxf51 (angle dxf10 (trans p2 0 uz)))
   (entmakex (list '(0 . "ARC") '(100 . "AcDbEntity") '(100 . "AcDbCircle") (cons 10 dxf10) (cons 40 dxf40) (cons 210 dxf210) '(100 . "AcDbArc") (cons 50 dxf50) (cons 51 dxf51)))
 )

 (prompt "\nSelect intersecting lines...")
 (setq ss (ssget "_:L" '((0 . "LINE"))))
 (while (not ss)
   (prompt "\nEmpty sel.set... Please select intersecting lines again...")
   (setq ss (ssget "_:L" '((0 . "LINE"))))
 )
 (repeat (setq i (sslength ss))
   (setq li (ssname ss (setq i (1- i))))
   (setq lil (cons li lil))
   (setq lixl (cons (entget li) lixl))
 )
 (setq lill lil)
 (foreach li1 lil
   (setq lill (vl-remove li1 lill))
   (foreach li2 lill
     (if (setq p (vlax-invoke (vlax-ename->vla-object li1) 'intersectwith (vlax-ename->vla-object li2) acextendnone))
       (setq pl (cons p pl))
     )
   )
 )
 (if (null pl)
   (progn
     (prompt "\nLines don't intersect... Restart routine and choose lines that intersect each other... Quitting...")
     (exit)
   )
   (vl-some '(lambda ( x ) (if (vl-every '(lambda ( p ) (vlax-curve-getparamatpoint x p)) pl) (setq ml x))) lil)
 )
 (setq lilr (vl-remove ml lil))
 (setq sp (trans (cdr (assoc 10 (entget ml))) 0 1) ep (trans (cdr (assoc 11 (entget ml))) 0 1))
 (foreach li lilr
   (setq p1 (trans (cdr (assoc 10 (entget li))) 0 1) p2 (trans (cdr (assoc 11 (entget li))) 0 1))
   (setq rlpl (cons (list li (vl-some '(lambda ( p ) (if (vlax-curve-getparamatpoint li p) p nil)) pl) (list p1 p2)) rlpl))
 )
 (initget 7)
 (setq r (getdist "\nPick or specify fillet radius : "))
 (foreach rlp rlpl
   (if (eq (cadr rlp) nil) (setq rlpl (vl-remove rlp rlpl)))
 )
 (prompt "\nMove mouse around selected lines and when desired fillets are displayed click mouse button to accept...")
 (while (and (/= (car (setq gr (grread t))) 3) (/= (car gr) 11) (/= (car gr) 25))
   (if (< (distance (setq p (cadr gr)) sp) (distance p ep))
     (progn
       (if (null x)
         (progn
           (if arcl 
             (progn
               (mapcar 'entdel arcl)
               (setq arcl nil)
             )
           )
           (mapcar '(lambda ( x ) (entmod x)) lixl)
           (setq rlpl (vl-sort rlpl '(lambda ( a b ) (< (distance (cadr a) (cdr (assoc 10 (entget ml)))) (distance (cadr b) (cdr (assoc 10 (entget ml))))))))
           (foreach rlp rlpl
             (if (or
                   (equal (distance (3d2d (cadr (caddr rlp))) (setq ip (inters (3d2d (cadr (caddr rlp))) (3d2d p) (3d2d sp) (3d2d ep) nil))) (+ (distance (3d2d (cadr (caddr rlp))) (3d2d p)) (distance (3d2d p) ip)) 1e-6)
                   (equal (distance (3d2d (cadr (caddr rlp))) (setq ip (inters (3d2d (cadr (caddr rlp))) (3d2d p) (3d2d sp) (3d2d ep) nil))) (+ (distance (3d2d (cadr (caddr rlp))) (3d2d p)) (distance (3d2d (cadr (caddr rlp))) ip)) 1e-6)
                 )
               (progn
                 (setq a (angle3d (cdr (assoc 10 (entget ml))) (cadr rlp) (cdr (assoc 11 (entget (car rlp))))))
                 (setq d (/ r (/ (sin (/ a 2.0)) (cos (/ a 2.0)))))
                 (setq v (unit (mapcar '- (cdr (assoc 11 (entget (car rlp)))) (cdr (assoc 10 (entget (car rlp)))))))
                 (entmod (subst (cons 10 (mapcar '+ (cadr rlp) (list (* (car v) d) (* (cadr v) d) (* (caddr v) d)))) (assoc 10 (entget (car rlp))) (entget (car rlp))))
                 (setq aep1 (cdr (assoc 10 (entget (car rlp)))))
                 (setq v (unit (mapcar '- (cdr (assoc 10 (entget ml))) (cdr (assoc 11 (entget ml))))))
                 (setq aep2 (mapcar '+ (cadr rlp) (list (* (car v) d) (* (cadr v) d) (* (caddr v) d))))
                 (setq li (entmakex (list '(0 . "LINE") (cons 10 (cadr rlp)) (cons 11 (mapcar '/ (mapcar '+ aep1 aep2) (list 2.0 2.0 2.0))))))
                 (setq cp (vlax-curve-getclosestpointto li aep1 t))
                 (setq v (unit (mapcar '- (cadr rlp) cp)))
                 (setq cp (mapcar '+ (cadr rlp) (list (* (- (car v)) (setq dd (sqrt (+ (expt d 2) (expt r 2))))) (* (- (cadr v)) dd) (* (- (caddr v)) dd))))
                 (setq arc (marc cp aep1 aep2))
                 (setq arcl (cons arc arcl))
                 (entdel li)
               )
               (progn
                 (setq a (angle3d (cdr (assoc 10 (entget ml))) (cadr rlp) (cdr (assoc 10 (entget (car rlp))))))
                 (setq d (/ r (/ (sin (/ a 2.0)) (cos (/ a 2.0)))))
                 (setq v (unit (mapcar '- (cdr (assoc 10 (entget (car rlp)))) (cdr (assoc 11 (entget (car rlp)))))))
                 (entmod (subst (cons 11 (mapcar '+ (cadr rlp) (list (* (car v) d) (* (cadr v) d) (* (caddr v) d)))) (assoc 11 (entget (car rlp))) (entget (car rlp))))
                 (setq aep1 (cdr (assoc 11 (entget (car rlp)))))
                 (setq v (unit (mapcar '- (cdr (assoc 10 (entget ml))) (cdr (assoc 11 (entget ml))))))
                 (setq aep2 (mapcar '+ (cadr rlp) (list (* (car v) d) (* (cadr v) d) (* (caddr v) d))))
                 (setq li (entmakex (list '(0 . "LINE") (cons 10 (cadr rlp)) (cons 11 (mapcar '/ (mapcar '+ aep1 aep2) (list 2.0 2.0 2.0))))))
                 (setq cp (vlax-curve-getclosestpointto li aep1 t))
                 (setq v (unit (mapcar '- (cadr rlp) cp)))
                 (setq cp (mapcar '+ (cadr rlp) (list (* (- (car v)) (setq dd (sqrt (+ (expt d 2) (expt r 2))))) (* (- (cadr v)) dd) (* (- (caddr v)) dd))))
                 (setq arc (marc cp aep1 aep2))
                 (setq arcl (cons arc arcl))
                 (entdel li)
               )
             )
           )
           (entmod (subst (cons 11 aep2) (assoc 11 (entget ml)) (entget ml)))
           (setq x t)
         )
       )
     )
     (progn
       (if x
         (progn
           (if arcl 
             (progn
               (mapcar 'entdel arcl)
               (setq arcl nil)
             )
           )
           (mapcar '(lambda ( x ) (entmod x)) lixl)
           (setq rlpl (vl-sort rlpl '(lambda ( a b ) (< (distance (cadr a) (cdr (assoc 11 (entget ml)))) (distance (cadr b) (cdr (assoc 11 (entget ml))))))))
           (foreach rlp rlpl
             (if (or
                   (equal (distance (3d2d (cadr (caddr rlp))) (setq ip (inters (3d2d (cadr (caddr rlp))) (3d2d p) (3d2d sp) (3d2d ep) nil))) (+ (distance (3d2d (cadr (caddr rlp))) (3d2d p)) (distance (3d2d p) ip)) 1e-6)
                   (equal (distance (3d2d (cadr (caddr rlp))) (setq ip (inters (3d2d (cadr (caddr rlp))) (3d2d p) (3d2d sp) (3d2d ep) nil))) (+ (distance (3d2d (cadr (caddr rlp))) (3d2d p)) (distance (3d2d (cadr (caddr rlp))) ip)) 1e-6)
                 )
               (progn
                 (setq a (angle3d (cdr (assoc 11 (entget ml))) (cadr rlp) (cdr (assoc 11 (entget (car rlp))))))
                 (setq d (/ r (/ (sin (/ a 2.0)) (cos (/ a 2.0)))))
                 (setq v (unit (mapcar '- (cdr (assoc 11 (entget (car rlp)))) (cdr (assoc 10 (entget (car rlp)))))))
                 (entmod (subst (cons 10 (mapcar '+ (cadr rlp) (list (* (car v) d) (* (cadr v) d) (* (caddr v) d)))) (assoc 10 (entget (car rlp))) (entget (car rlp))))
                 (setq aep1 (cdr (assoc 10 (entget (car rlp)))))
                 (setq v (unit (mapcar '- (cdr (assoc 11 (entget ml))) (cdr (assoc 10 (entget ml))))))
                 (setq aep2 (mapcar '+ (cadr rlp) (list (* (car v) d) (* (cadr v) d) (* (caddr v) d))))
                 (setq li (entmakex (list '(0 . "LINE") (cons 10 (cadr rlp)) (cons 11 (mapcar '/ (mapcar '+ aep1 aep2) (list 2.0 2.0 2.0))))))
                 (setq cp (vlax-curve-getclosestpointto li aep1 t))
                 (setq v (unit (mapcar '- (cadr rlp) cp)))
                 (setq cp (mapcar '+ (cadr rlp) (list (* (- (car v)) (setq dd (sqrt (+ (expt d 2) (expt r 2))))) (* (- (cadr v)) dd) (* (- (caddr v)) dd))))
                 (setq arc (marc cp aep1 aep2))
                 (setq arcl (cons arc arcl))
                 (entdel li)
               )
               (progn
                 (setq a (angle3d (cdr (assoc 11 (entget ml))) (cadr rlp) (cdr (assoc 10 (entget (car rlp))))))
                 (setq d (/ r (/ (sin (/ a 2.0)) (cos (/ a 2.0)))))
                 (setq v (unit (mapcar '- (cdr (assoc 10 (entget (car rlp)))) (cdr (assoc 11 (entget (car rlp)))))))
                 (entmod (subst (cons 11 (mapcar '+ (cadr rlp) (list (* (car v) d) (* (cadr v) d) (* (caddr v) d)))) (assoc 11 (entget (car rlp))) (entget (car rlp))))
                 (setq aep1 (cdr (assoc 11 (entget (car rlp)))))
                 (setq v (unit (mapcar '- (cdr (assoc 11 (entget ml))) (cdr (assoc 10 (entget ml))))))
                 (setq aep2 (mapcar '+ (cadr rlp) (list (* (car v) d) (* (cadr v) d) (* (caddr v) d))))
                 (setq li (entmakex (list '(0 . "LINE") (cons 10 (cadr rlp)) (cons 11 (mapcar '/ (mapcar '+ aep1 aep2) (list 2.0 2.0 2.0))))))
                 (setq cp (vlax-curve-getclosestpointto li aep1 t))
                 (setq v (unit (mapcar '- (cadr rlp) cp)))
                 (setq cp (mapcar '+ (cadr rlp) (list (* (- (car v)) (setq dd (sqrt (+ (expt d 2) (expt r 2))))) (* (- (cadr v)) dd) (* (- (caddr v)) dd))))
                 (setq arc (marc cp aep1 aep2))
                 (setq arcl (cons arc arcl))
                 (entdel li)
               )
             )
           )
           (entmod (subst (cons 10 aep2) (assoc 10 (entget ml)) (entget ml)))
           (setq x nil)
         )
       )
     )
   )
 )
 (princ)
)

HTH, M.R.

Edited by marko_ribar
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
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.

×
×
  • Create New...