; 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)
(while (setq pt (getpoint "\nPick ridge point "))
(setvar 'osmode 0)
;(setq pt2 (getpoint pt "\nPick gap in ridge lines "))
; (setq ang (angle pt pt2))
(setq ang 0.0)
(setq pi20 (/ (* 2.0 pi) 20.0))
(setq co-ord '())
(repeat 20
(setq pt2 (polar pt (setq ang (+ pi20 ang)) 0.3))
(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 "fillet" pt1 pt2 )
(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" pt1 pt2 )
(setvar 'osmode 1)
)
(setvar 'osmode oldsnap)
(princ)
)
(c:test)
; 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)
; 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)