Results 1 to 3 of 3

Thread: Fillet perpendicular lines

  1. 2015-07-31, 05:07 PM #1
    Raudel Hinojosa Sr
    Raudel Hinojosa Sr is offline
    Member
    Join Date
    2000-11
    Posts
    12
    Login to Give a bone
    0

    Default Fillet perpendicular lines

    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?

    Attached Images Attached Images
    Reply With Quote Reply With Quote
  2. 2015-08-01, 04:04 AM #2
    marko_ribar
    marko_ribar is offline
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Default Re: Fillet perpendicular lines

    http://www.cadtutor.net/forum/showth...ny-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 :

    Code:
    (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)
)
    Last edited by marko_ribar; 2015-08-01 at 04:54 AM. Reason: added optional code
    Reply With Quote Reply With Quote
  3. 2015-08-07, 06:40 AM #3
    BIG-AL
    BIG-AL is offline
    All AUGI, all the time
    Join Date
    2003-07
    Posts
    560
    Login to Give a bone
    0

    Default Re: Fillet perpendicular lines

    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.

    Code:
    ; 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
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

Similar Threads

  1. Fillet two lines
    By cgerhardt in forum VBA/COM Interop
    Replies: 9
    Last Post: 2018-10-24, 01:29 PM
  2. Extension Lines on Arc Length Dimension Always Perpendicular
    By autocad.wishlist1734 in forum AutoCAD Wish List
    Replies: 0
    Last Post: 2009-02-01, 05:08 PM
  3. vlax routine perpendicular lines along polyline.
    By Opie in forum AutoLISP
    Replies: 11
    Last Post: 2007-08-28, 10:25 PM
  4. Non-parallel/perpendicular grid lines
    By DanielleAnderson in forum Revit Architecture - General
    Replies: 2
    Last Post: 2006-11-16, 07:22 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Forum Rules