Author Topic: automatic fillet-trim  (Read 1346 times)

0 Members and 1 Guest are viewing this topic.

domenicomaria

  • Swamp Rat
  • Posts: 723
automatic fillet-trim
« on: July 07, 2022, 02:44:38 AM »
is there a routine or command (maybe in BCAD) that simply by selecting objects (lines, polylines, arcs...)
transforms the green and yellow drawing into the magenta one ?

Obviously, a parameter must be set that defines the maximum allowed distance between the vertices of the entities . . .

I could try to write this routine . . .
. . .
but if it already exists. . .  :-)
« Last Edit: July 07, 2022, 03:42:48 AM by domenicomaria »

dexus

  • Newt
  • Posts: 197
Re: automatic fillet-trim
« Reply #1 on: July 07, 2022, 03:51:07 AM »
For the top one you can use PEDIT.

PEDIT => Multiple => Select objects => Join => Type in a Fuzz (larger than the largest gap) => Enter => Enter

Edit, I guess you could also make a routine like this:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo (/ acc ss)
  2.   (setq acc (getvar "PEDITACCEPT"))
  3.   (if (setq ss (ssget '((0 . "ARC,*POLYLINE,LINE"))))
  4.     (progn
  5.       (setvar "PEDITACCEPT" 1)
  6.       (command "_.pedit" "_M" ss "" "_J" "100" "") ; Fill in a large enough fuzz here
  7.     )
  8.   )
  9.   (setvar "PEDITACCEPT" acc)
  10.   (princ)
  11. )

And for the second one you could have a look at: http://www.lee-mac.com/intersectionfunctions.html
That way you can find the intersections, but changing the lines will be the challenge. 
« Last Edit: July 07, 2022, 03:57:15 AM by dexus »

domenicomaria

  • Swamp Rat
  • Posts: 723
Re: automatic fillet-trim
« Reply #2 on: July 07, 2022, 04:06:09 AM »
For the top one you can use PEDIT.

PEDIT => Multiple => Select objects => Join => Type in a Fuzz (larger than the largest gap) => Enter => Enter

Edit, I guess you could also make a routine like this:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:foo (/ acc ss)
  2.   (setq acc (getvar "PEDITACCEPT"))
  3.   (if (setq ss (ssget '((0 . "ARC,*POLYLINE,LINE"))))
  4.     (progn
  5.       (setvar "PEDITACCEPT" 1)
  6.       (command "_.pedit" "_M" ss "" "_J" "100" "") ; Fill in a large enough fuzz here
  7.     )
  8.   )
  9.   (setvar "PEDITACCEPT" acc)
  10.   (princ)
  11. )

And for the second one you could have a look at: http://www.lee-mac.com/intersectionfunctions.html
That way you can find the intersections, but changing the lines will be the challenge.

thanks Dexus
. . .
your suggestions are very useful . . .
. . .
I know and had also thought about studying, deepening and using Lee Mac's "Intersection Functions". . .
. . .
ciao

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: automatic fillet-trim
« Reply #3 on: July 07, 2022, 09:24:06 PM »
The second can be done via TRIM, select cut line, use the F option, "Fence" and drag over the little bits sticking out.

So in a programming sense pick cut line, pick side, you offset the end points a very small amount and use these points as input to the "F" option. This is much easier than intersectwith. For more complicated extends like a pline note straights only use offset to work out points.

Code: [Select]
(defun c:wow ( /  ent entg end start pt oldsnap )
(setq ent (entsel "\nSelect cut line "))
(setq entg (entget (car ent)))
(setq end  (cdr (assoc 10 entg)) start  (cdr (assoc 11 entg)))
(setq pt (getpoint "\nPick a point for side "))
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq end (polar end  (angle end pt) 0.001))
(setq start (polar start (angle start pt) 0.001))
(command "TRIM" ent "" "F" (list end start) "" "")
(setvar 'osmode oldsnap)
(princ)
)
(c:wow)



A man who never made a mistake never made anything

domenicomaria

  • Swamp Rat
  • Posts: 723
Re: automatic fillet-trim
« Reply #4 on: July 08, 2022, 02:03:47 AM »
EXTRIM make the same thing, but better ...

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: automatic fillet-trim
« Reply #5 on: July 08, 2022, 09:54:35 PM »
To use extrim in Bricscad may need to load the EXPRESS TOOLS module.

https://boa.bricsys.com/applications/
A man who never made a mistake never made anything

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: automatic fillet-trim
« Reply #6 on: July 09, 2022, 01:40:20 AM »
To use extrim in Bricscad may need to load the EXPRESS TOOLS module.

https://boa.bricsys.com/applications/

Why would someone need to use BricsCAD or AutoCAD or ... ?
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: automatic fillet-trim
« Reply #7 on: July 11, 2022, 01:59:53 AM »
Just slightly different, but not tested still...

Code: [Select]
(defun c:redrawcrossings-new ( / *error* catch_cont unit v^v _inters ss i lil ip ) ;;; cad & doc & spc & alo - global variables ;;; *varlst* & *varvals* - global variables ;;;

  (or cad (progn (vl-load-com) (setq cad (vlax-get-acad-object))))
  (or doc (setq doc (vla-get-activedocument cad)))
  (or spc (setq spc (vla-get-block (setq alo (vla-get-activelayout doc)))))

  (defun *error* ( m )
    (if command-s
      (command-s "_.undo" "_e")
      (vl-cmdf "_.undo" "_e")
    )
    (if *varlst*
      (mapcar (function setvar) *varlst* *varvals*)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun catch_cont ( / catch )
    (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
    (while (and (or (not (equal (grread) '(2 13))) (not (vl-catch-all-error-p (setq catch (vl-catch-all-apply (function /) (list 1 0)))))) (/= (car (grread)) 3)))
    (if (vl-catch-all-error-p catch)
      catch
    )
  )

  (defun unit ( v / d )
    (if (not (equal (setq d (distance v (list 0.0 0.0 0.0))) 0.0 1e-8))
      (mapcar (function (lambda ( x ) (/ x d))) v)
      (progn
        (prompt "\ncatched error in (unit) - invalid input - reference vector strength near 0.0")
        (if (vl-catch-all-error-p (catch_cont))
          (vl-catch-all-apply (function /) (list 1 0))
        )
      )
    )
  )

  (defun v^v ( u v )
    (list
      (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
      (- (* (caddr u) (car v)) (* (car u) (caddr v)))
      (- (* (car u) (cadr v)) (* (cadr u) (car v)))
    )
  )

  (defun _inters ( l1 l2 / p1 p2 p3 p4 pl1 pl2 x1 x2 x3 x4 y1 y2 y3 y4 z1 z2 z3 z4 coplanar-p pln pl n dx12 dy12 dz12 dx34 dy34 dz34 k1 k2 n1 n2 xi yi zi ip )

    (setq pl1 (mapcar (function cdr) (vl-remove-if-not (function (lambda ( x ) (vl-position (car x) (list 10 11)))) (entget l1))))
    (setq x1 (car (car pl1)) y1 (cadr (car pl1)) z1 (caddr (car pl1)) x2 (car (cadr pl1)) y2 (cadr (cadr pl1)) z1 (caddr (cadr pl1)))
    (setq pl2 (mapcar (function cdr) (vl-remove-if-not (function (lambda ( x ) (vl-position (car x) (list 10 11)))) (entget l2))))
    (setq x3 (car (car pl2)) y3 (cadr (car pl2)) z3 (caddr (car pl2)) x4 (car (cadr pl2)) y4 (cadr (cadr pl2)) z4 (caddr (cadr pl2)))

    (defun coplanar-p ( p1 p2 p3 p4 / n1 n2 r )
      (setq n1 (unit (v^v (mapcar (function -) p2 p1) (mapcar (function -) p3 p1))))
      (setq n2 (unit (v^v (mapcar (function -) p2 p1) (mapcar (function -) p4 p1))))
      (setq r (or (equal n1 n2 1e-6) (equal n1 (mapcar (function -) n2) 1e-6)))
      (if r
        (list (mapcar (function (lambda ( x ) (trans x 1 n1))) (list p1 p2 p3 p4)) n1)
      )
    )

    (mapcar (function set) (list (quote p1) (quote p2) (quote p3) (quote p4)) (append pl1 pl2))
    (if (setq pln (coplanar-p p1 p2 p3 p4))
      (progn
        (setq pl (car pln) n (cadr pln))
        (mapcar (function set) (list (quote p1) (quote p2) (quote p3) (quote p4)) pl)
        (mapcar (function set) (list (quote x1) (quote y1) (quote z1)) p1)
        (mapcar (function set) (list (quote x2) (quote y2) (quote z2)) p2)
        (mapcar (function set) (list (quote x3) (quote y3) (quote z3)) p3)
        (mapcar (function set) (list (quote x4) (quote y4) (quote z4)) p4)
        (setq dx12 (- x2 x1) dy12 (- y2 y1) dz12 (- z2 z1)) ;; I suppose dz12 = 0 (trans from coplanar-p)
        (setq dx34 (- x4 x3) dy34 (- y4 y3) dz34 (- z4 z3)) ;; I suppose dz34 = 0 (trans from coplanar-p)
        (if (zerop dx12)
          (setq k1 1e+99)
          (setq k1 (/ dy12 dx12))
        )
        (if (zerop dx34)
          (setq k2 1e+99)
          (setq k2 (/ dy34 dx34))
        )
        (if (and k1 k2 (not (equal k1 k2 1e-6)))
          (progn
            ;; y=kx+n ;; n=y-kx
            (setq n1 (- y1 (* k1 x1)))
            (setq n2 (- y3 (* k2 x3)))
            ;; k1xi+n1=k2xi+n2 ;; yi=k1xi+n1
            ;; xi(k1-k2)=n2-n1 ;;
            (setq xi (/ (- n2 n1) (- k1 k2)))
            (setq yi (+ (* k1 xi) n1))
            (setq zi z1)
            (setq ip (trans (list xi yi zi) n 1))
          )
        )
      )
    )

  )

  (or *varlst* (setq *varlst* (list (if (getvar '3dosmode) "3dosmode" "osmode") "cmdecho")))
  (mapcar (function (lambda ( x y ) (setvar x y))) *varlst* (if *varvals* *varvals* (setq *varvals* (list 0 0))))
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (if command-s
      (command-s "_.undo" "_e")
      (vl-cmdf "_.undo" "_e")
    )
  )
  (if command-s
    (command-s "_.undo" "_g")
    (vl-cmdf "_.undo" "_g")
  )

  (prompt "\nSelect lines...")
  (setq ss (ssget "_:L" (list (cons 0 "LINE"))))
  (repeat (setq i (sslength ss))
    (setq lil (cons (ssname ss (setq i (1- i))) lil))
  )
  (foreach li1 lil
    (setq lil (cdr lil))
    (foreach li2 lil
      (setq ip (_inters li1 li2))
      (if (< (distance (cdr (assoc 10 (entget li1))) ip) (distance (cdr (assoc 11 (entget li1))) ip))
        (entupd (cdr (assoc -1 (entmod (subst (cons 10 ip) (assoc 10 (entget li1)) (entget li1))))))
        (entupd (cdr (assoc -1 (entmod (subst (cons 11 ip) (assoc 11 (entget li1)) (entget li1))))))
      )
      (if (< (distance (cdr (assoc 10 (entget li2))) ip) (distance (cdr (assoc 11 (entget li2))) ip))
        (entupd (cdr (assoc -1 (entmod (subst (cons 10 ip) (assoc 10 (entget li2)) (entget li2))))))
        (entupd (cdr (assoc -1 (entmod (subst (cons 11 ip) (assoc 11 (entget li2)) (entget li2))))))
      )
    )
  )
  (*error* nil)
)

Code: [Select]
(defun c:redrawcrossings-new ( / *error* fuzzchk catch_cont unit v^v _inters ss i lil ip li1x li2x fuzz ) ;;; cad & doc & spc & alo - global variables ;;; *varlst* & *varvals* - global variables ;;;

  (or cad (progn (vl-load-com) (setq cad (vlax-get-acad-object))))
  (or doc (setq doc (vla-get-activedocument cad)))
  (or spc (setq spc (vla-get-block (setq alo (vla-get-activelayout doc)))))

  (defun *error* ( m )
    (if command-s
      (command-s "_.undo" "_e")
      (vl-cmdf "_.undo" "_e")
    )
    (if *varlst*
      (mapcar (function setvar) *varlst* *varvals*)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun fuzzchk ( p pp fuzz )
    (if pp
      (equal (distance p pp) 0.0 fuzz)
    )
  )

  (defun catch_cont ( / catch )
    (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
    (while (and (or (not (equal (grread) '(2 13))) (not (vl-catch-all-error-p (setq catch (vl-catch-all-apply (function /) (list 1 0)))))) (/= (car (grread)) 3)))
    (if (vl-catch-all-error-p catch)
      catch
    )
  )

  (defun unit ( v / d )
    (if (not (equal (setq d (distance v (list 0.0 0.0 0.0))) 0.0 1e-8))
      (mapcar (function (lambda ( x ) (/ x d))) v)
      (progn
        (prompt "\ncatched error in (unit) - invalid input - reference vector strength near 0.0")
        (if (vl-catch-all-error-p (catch_cont))
          (vl-catch-all-apply (function /) (list 1 0))
        )
      )
    )
  )

  (defun v^v ( u v )
    (list
      (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
      (- (* (caddr u) (car v)) (* (car u) (caddr v)))
      (- (* (car u) (cadr v)) (* (cadr u) (car v)))
    )
  )

  (defun _inters ( l1 l2 / p1 p2 p3 p4 pl1 pl2 x1 x2 x3 x4 y1 y2 y3 y4 z1 z2 z3 z4 coplanar-p pln pl n dx12 dy12 dz12 dx34 dy34 dz34 k1 k2 n1 n2 xi yi zi ip )

    (setq pl1 (mapcar (function cdr) (vl-remove-if-not (function (lambda ( x ) (vl-position (car x) (list 10 11)))) (entget l1))))
    (setq x1 (car (car pl1)) y1 (cadr (car pl1)) z1 (caddr (car pl1)) x2 (car (cadr pl1)) y2 (cadr (cadr pl1)) z1 (caddr (cadr pl1)))
    (setq pl2 (mapcar (function cdr) (vl-remove-if-not (function (lambda ( x ) (vl-position (car x) (list 10 11)))) (entget l2))))
    (setq x3 (car (car pl2)) y3 (cadr (car pl2)) z3 (caddr (car pl2)) x4 (car (cadr pl2)) y4 (cadr (cadr pl2)) z4 (caddr (cadr pl2)))

    (defun coplanar-p ( p1 p2 p3 p4 / n1 n2 r )
      (setq n1 (unit (v^v (mapcar (function -) p2 p1) (mapcar (function -) p3 p1))))
      (setq n2 (unit (v^v (mapcar (function -) p2 p1) (mapcar (function -) p4 p1))))
      (setq r (or (equal n1 n2 1e-6) (equal n1 (mapcar (function -) n2) 1e-6)))
      (if r
        (list (mapcar (function (lambda ( x ) (trans x 1 n1))) (list p1 p2 p3 p4)) n1)
      )
    )

    (mapcar (function set) (list (quote p1) (quote p2) (quote p3) (quote p4)) (append pl1 pl2))
    (if (setq pln (coplanar-p p1 p2 p3 p4))
      (progn
        (setq pl (car pln) n (cadr pln))
        (mapcar (function set) (list (quote p1) (quote p2) (quote p3) (quote p4)) pl)
        (mapcar (function set) (list (quote x1) (quote y1) (quote z1)) p1)
        (mapcar (function set) (list (quote x2) (quote y2) (quote z2)) p2)
        (mapcar (function set) (list (quote x3) (quote y3) (quote z3)) p3)
        (mapcar (function set) (list (quote x4) (quote y4) (quote z4)) p4)
        (setq dx12 (- x2 x1) dy12 (- y2 y1) dz12 (- z2 z1)) ;; I suppose dz12 = 0 (trans from coplanar-p)
        (setq dx34 (- x4 x3) dy34 (- y4 y3) dz34 (- z4 z3)) ;; I suppose dz34 = 0 (trans from coplanar-p)
        (if (zerop dx12)
          (setq k1 1e+99)
          (setq k1 (/ dy12 dx12))
        )
        (if (zerop dx34)
          (setq k2 1e+99)
          (setq k2 (/ dy34 dx34))
        )
        (if (and k1 k2 (not (equal k1 k2 1e-6)))
          (progn
            ;; y=kx+n ;; n=y-kx
            (setq n1 (- y1 (* k1 x1)))
            (setq n2 (- y3 (* k2 x3)))
            ;; k1xi+n1=k2xi+n2 ;; yi=k1xi+n1
            ;; xi(k1-k2)=n2-n1 ;;
            (setq xi (/ (- n2 n1) (- k1 k2)))
            (setq yi (+ (* k1 xi) n1))
            (setq zi z1)
            (setq ip (trans (list xi yi zi) n 1))
          )
        )
      )
    )

  )

  (or *varlst* (setq *varlst* (list (if (getvar '3dosmode) "3dosmode" "osmode") "cmdecho")))
  (mapcar (function (lambda ( x y ) (setvar x y))) *varlst* (if *varvals* *varvals* (setq *varvals* (list 0 0))))
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (if command-s
      (command-s "_.undo" "_e")
      (vl-cmdf "_.undo" "_e")
    )
  )
  (if command-s
    (command-s "_.undo" "_g")
    (vl-cmdf "_.undo" "_g")
  )

  (initget 6)
  (setq fuzz (getdist "\nPick or specify fuzz distance <1.0> : "))
  (if (not fuzz)
    (setq fuzz 1.0)
  )
  (prompt "\nSelect lines...")
  (setq ss (ssget "_:L" (list (cons 0 "LINE"))))
  (repeat (setq i (sslength ss))
    (setq lil (cons (ssname ss (setq i (1- i))) lil))
  )
  (foreach li1 lil
    (setq lil (cdr lil))
    (foreach li2 lil
      (setq ip (_inters li1 li2))
      (cond
        ( (fuzzchk (cdr (assoc 10 (setq li1x (entget li1)))) ip fuzz)
          (entupd (cdr (assoc -1 (entmod (subst (cons 10 ip) (assoc 10 li1x) li1x)))))
        )
        ( (fuzzchk (cdr (assoc 11 li1x)) ip fuzz)
          (entupd (cdr (assoc -1 (entmod (subst (cons 11 ip) (assoc 11 li1x) li1x)))))
        )
      )
      (cond
        ( (fuzzchk (cdr (assoc 10 (setq li2x (entget li2)))) ip fuzz)
          (entupd (cdr (assoc -1 (entmod (subst (cons 10 ip) (assoc 10 li2x) li2x)))))
        )
        ( (fuzzchk (cdr (assoc 11 li2x)) ip fuzz)
          (entupd (cdr (assoc -1 (entmod (subst (cons 11 ip) (assoc 11 li2x) li2x)))))
        )
      )
    )
  )
  (*error* nil)
)
« Last Edit: July 27, 2022, 05:12:05 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube