Code Red > AutoLISP (Vanilla / Visual)

Help with DoubleOffset lisp - LeeMac Code

<< < (3/4) > >>

PM:
can any one fix it?

BIGAL:
Need some time made a start on it be patient.

PM:
Thanks BIGAL

BIGAL:
Sorry took so long had a few other tasks, it only does ridge caps at moment, there is one spot where in you sample it will not work as you have 2 ridges to close so the search polygon gets confused. So just pick the top of the red line. The same method should be able to be used on the eaves.


--- Code: ---; 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)


--- End code ---

PM:
Hi BIGAL . Thanks for your time. I try your code but is not working as i expect. Is faster to do filet 0 . Your code create arcs in the roof and became a mess.

Thanks again

Navigation

[0] Message Index

[#] Next page

[*] Previous page