View Full Version : Fillet perpendicular lines
Raudel Hinojosa Sr
2015-07-31, 05:07 PM
Looking for a lisp that will add a fillet to two perpendicular lines. When we draw 2d plumbing sanitary lines we like to show the wye fitting where a line comes into another line. It would be great if we could just draw the lines all connecting perpendicular to each other then come back and pick the main line then all the lines that come into that line and fillet them or chamfer would work as well.
Anybody seen this out there before?
http://forums.augi.com/attachment.php?attachmentid=100126&stc=1
marko_ribar
2015-08-01, 04:04 AM
http://www.cadtutor.net/forum/showthread.php?92378-one-line-to-many-fillet&p=#3
Maybe this link can help... M.R.
Or if you want the main line to be untrimmed after fillets, just comment out those 2 highlighted lines :
(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)
... subs ...
... start of main routine ...
(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)
)
BIG-AL
2015-08-07, 06:40 AM
A slightly different version line crossing, meets on any angle etc, but is very simple one at a time. Only rule do clockwise when picking lines, this implies where the arc is to go.
; draws an arc between 2 lines but does not erase
; by Alan H Aug 2015
(defun c:arcfill ( / pt1 pt2 pt3 pt4 obj1 obj2 obj3 obj4 obj5 obj6 pt5)
(alert "Pick in clockwise direction")
(setq oldsnap (getvar 'osmode))
(setvar 'Osmode 512)
(setq pt1 (getpoint "\npick 1st line"))
(setq obj1 (ssname (ssget pt1) 0))
(setq obj5 (vlax-ename->vla-object obj1)) ; convert to vl
(setq pt2 (getpoint "\npick 2nd line"))
(setq obj2 (ssname (ssget pt2) 0))
(setq obj6 (vlax-ename->vla-object obj2)) ; convert to vl
(setq rad (getdist "\nEter radius"))
(command "offset" rad Obj1 pt2 "")
(setq obj3 (vlax-ename->vla-object (entlast)))
(command "offset" rad Obj2 pt1 "")
(setq obj4 (vlax-ename->vla-object (entlast)))
(setq pt5 (vlax-invoke obj3 'intersectWith obj4 acExtendThisEntity)) ; centre pt
(setq pt3 (vlax-curve-getClosestPointto obj6 pt5))
(setq pt4 (vlax-curve-getClosestPointto obj5 pt5))
(command "arc" "C" pt5 pt3 pt4)
(vla-delete obj3)
(vla-delete obj4)
(setvar 'osmode oldsnap)
)
(c:arcfill)l
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.