The code works in Bricscad but not in Autocad. Which was disappointing I am now rewriting for both.
I have found that Autocad must be able to see the points when filleting and that may be the problem. So will look at zooming or an alternative of picking the fillet points.
There is a problem in one area it will not work as you have two ridges to close to work out the line order.
Re outside eave can use extrim to auto trim overshoot, just did manual very easy, extended everything then extrim.
I have had to revert back to a version 1 to get to work in Autocad. You need to drag a start angle line. Its not perfect. I will work on it. Doing some weird things when getting the line order.
The fillet problem is to do with the pick point needs to be closer to the fillet point, say 20% instead of mid pt. Bricscad works even if unseen.
; fillet offset roof ridges for offset lines equal ridge capping.
; by AlanH April 2021 info@alanh.com.au
(defun AHpllst ( lstpl / x)
(command "_pline")
(while (= (getvar "cmdactive") 1 )
(repeat (setq x (length lstpl))
(command (nth (setq x (- x 1)) lstpl))
)
(command "")
)
)
(defun c:test ( / oldsnap)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 1)
(setq pi30 (/ (* 2.0 pi) 30.0))
(while (setq pt (getpoint "\nPick ridge point Enter to exit "))
(setq pt2 (getpoint pt "\nPick internal gap in ridge lines "))
(setq ang (angle pt pt2))
(setvar 'osmode 0)
(setq co-ord '())
(repeat 30
(setq pt2 (polar pt (setq ang (+ pi30 ang)) 0.21))
(setq co-ord (cons pt2 co-ord))
)
;(setq co-ord (cons (last co-ord) co-ord))
(AHpllst co-ord)
(setq obj1 (vlax-ename->vla-object (entlast)))
(setq ss (ssget "F" co-ord '((0 . "LINE")(8 . "ROOF"))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq obj2 (vlax-ename->vla-object ent))
(setq pt (vlax-invoke obj2 'intersectWith obj1 acExtendnone))
(setq dist (vlax-curve-getdistatpoint obj1 pt))
(setq lst (cons (list dist pt (cdr (assoc -1 (entget ent)))) lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
(vla-delete obj1)
(setvar 'filletrad 0.0)
(setq x 1)
(setvar 'osmode 512)
(setq x 1)
(repeat (- (/ (length lst) 2) 1)
(setq l1 (entget (nth 2 (nth x lst))))
( setq pt1 (mapcar '* (mapcar '+ (cdr (assoc 10 l1)) (cdr (assoc 11 l1))) '(0.5 0.5)))
(setq l2 (entget (nth 2 (nth (+ x 1) lst))))
( setq pt2 (mapcar '* (mapcar '+ (cdr (assoc 10 l2)) (cdr (assoc 11 l2))) '(0.5 0.5)))
(command "zoom" "C" pt 5.0)
;(command "fillet" pt1 pt2 )
(command "fillet" (nth 2 (nth x lst)) pt2 )
(command "zoom" "P" )
(setq x (+ x 2))
)
(setq l1 (entget (nth 2 (nth 0 lst))))
( setq pt1 (mapcar '* (mapcar '+ (cdr (assoc 10 l1)) (cdr (assoc 11 l1))) '(0.5 0.5)))
(setq l2 (entget (nth 2 (last lst))))
( setq pt2 (mapcar '* (mapcar '+ (cdr (assoc 10 l2)) (cdr (assoc 11 l2))) '(0.5 0.5)))
(command "fillet" (nth 2 (nth 0 lst)) pt2 )
(setvar 'osmode 1)
)
(setvar 'osmode oldsnap)
(princ)
)
(c:test)
For eave tested in Autocad.
; Clean up eave line for ridge capping
; By AlanH April 2021
(defun c:test2 ( / oldsnap ent obj pmin pmax mp outpt off1 obj1 obj2 ss co-ord lst intpt )
(setq oldsnap (getvar 'osmode))
(setq ent (car (entsel "\nPick eave pline ")))
(setq obj (vlax-ename->vla-object ent))
(vla-GetBoundingBox obj 'minpoint 'maxpoint)
(setq pmin (vlax-safearray->list minpoint))
(setq pmax (vlax-safearray->list maxpoint))
(setq mp (mapcar '* (mapcar '+ pmin pmax) '(0.5 0.5)))
(setq outpt (polar pmax (angle pmin pmax) 1.0))
(command "offset" 0.25 ent mp "")
(setq off1 (entlast))
(setq obj1 (vlax-ename->vla-object off1))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget off1))))
(setq ss (ssget "F" co-ord '((0 . "line"))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq obj2 (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq intpt (vlax-invoke obj2 'intersectWith obj1 acExtendNone))
(setq lst (cons intpt lst))
)
(setq lst (cons (last lst) lst))
(command "erase" off1 "")
(command "offset" 0.25 ent outpt "")
(setq off1 (entlast))
(setvar 'osmode 512)
(command "extend" off1 "" "F")
(while (= (getvar "cmdactive") 1 )
(repeat (setq x (length lst))
(command (nth (setq x (- x 1)) lst))
)
(command "" "")
)
(command "erase" off1 "")
(if (null etrim) (load "extrim.lsp"))
(etrim ent outpt)
(setvar 'osmode oldsnap)
(princ)
) ; defun
(c:test2)
Problem spot if I decrease radius then does not work else where.