Topic: ==={Challenge}===Find the ridge lines of sloped roof

[highflyingbird]

Given a closed polyline, To find the ridge lines of sloped roof, suppose if  every side  has the same slope.

 

[Serge J. Gianolla]

Where were you 6 years ago! 
http://www.theswamp.org/index.php?topic=9659.msg123862;topicseen#msg123862
 

[Lee Mac]

I have a LISP solution which I believe yields the correct straight skeleton result for 90% of cases, but have not released it as freeware:



Some more examples:

[highflyingbird]

I have a LISP solution which I believe yields the correct straight skeleton result for 90% of cases, but have not released it as freeware:
..

You are great! I wish it won't undercut your business!

[Krushert]

Not to be a party pooper.  But I only about the 15% buildings I do have a consistant pitch thus having the ridge line at the same height. 

My architects like to have a roof have the following artistic charater and charming features:

• change the pitch
• have differnt heights for the ridge
• have different heights for the eaves
• have wierd things happen at the interesction of rakes and eaves.
• all of the @#$%!  *&^%!  %^&$$#^ above.

:pissed:

[CAB]

Where were you 6 years ago! 
http://www.theswamp.org/index.php?topic=9659.msg123862;topicseen#msg123862
 

Yes, that one has alluded me for a long time. 

[CAB]

Current project. Roof ridge is not correct but close.
It is a remodel so I don't need it to be correct.

[Krushert]

Current project. Roof ridge is not correct but close.
It is a remodel so I don't need it to be correct.

Holly Batman and I thought I had it bad!  We do a lot of wood framed apartment buildings so little more consistency before a change in a roof plane.  I forgot about McMansions.

Do you usually the document the plate height on the roof plan?  I kind a like that.

[CAB]

Plate height usually appear on the framing plan in the form of different hatches on the walls (plan view).
If it gets too complicated I provide a separate sheet just for plate heights.
The roof plan as you see above usual ends up as a 1/8 scale on the framing plan if there is room.
So at 1/8 scale it might be tough to see the text but I like that idea. 

[ribarm]

Here is mine version (nobody posted code ) and as I am not real programmer as Lee, it's quite risky to be used... With some complex plines it can make quite mess, but on the other hand maybe someone can use it as it makes construction of roof solution... I just don't know how to make it better and as Lee won't post his solution at least I tried...

Code - Auto/Visual Lisp: [Select]

1. (defun pll (pl / K MSP PLA PLAO PLO PLOPTLST PLPTLST PTT PTTLST PTTLSTN DST VAR) (vl-load-com)
2.   (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
3.   (setq pla (vlax-ename->vla-object pl))
4.   (if (vl-catch-all-error-p (setq var (vl-catch-all-apply 'vla-offset (list pla -1e-3)))) (setq plao nil) (setq plao (car (vlax-safearray->list (vlax-variant-value var)))))
5.   (if plao (setq plo (vlax-vla-object->ename plao)))
6.   (if (> (cdr (assoc 90 (entget pl))) 2)
7.     (progn
8.       (mapcar '(lambda (x) (if (eq (car x) 10) (setq plptlst (cons (cdr x) plptlst)))) (entget pl))
9.       (setq plptlst (reverse plptlst))
10.     )
11.   )
12.   (if plo
13.     (progn
14.       (mapcar '(lambda (x) (if (eq (car x) 10) (setq ploptlst (cons (cdr x) ploptlst)))) (entget plo))
15.       (setq ploptlst (reverse ploptlst))
16.       (entdel plo)
17.     )
18.   )
19.   (setq k -1)
20.   (if ploptlst
21.     (progn
22.       (repeat (length plptlst)
23.         (setq k (1+ k))
24.         (if (eq k (- (length plptlst) 1))
25.           (setq ptt (inters (nth k plptlst) (nth k ploptlst) (nth 0 plptlst) (nth 0 ploptlst) nil))
26.           (setq ptt (inters (nth k plptlst) (nth k ploptlst) (nth (+ k 1) plptlst) (nth (+ k 1) ploptlst) nil))
27.         )
28.         (if (and ptt (eq k (- (length plptlst) 1))) (setq pttlst (cons (distance (nth 0 plptlst) ptt) pttlst)))
29.         (if (and ptt (not (eq k (- (length plptlst) 1)))) (setq pttlst (cons (distance (nth k plptlst) ptt) pttlst)))
30.         (if (and ptt (< k (- (length plptlst) 1))) (setq pttlst (cons (distance (nth (+ k 1) plptlst) ptt) pttlst)))
31.       )
32.       (setq pttlstn (vl-sort pttlst '(lambda (a b) (< a b))))
33.       (setq dst (car pttlstn))
34.       (setq k -1)
35.       (repeat (length plptlst)
36.         (setq k (1+ k))
37.         (if (eq k (- (length plptlst) 1))
38.           (setq ptt (inters (nth k plptlst) (nth k ploptlst) (nth 0 plptlst) (nth 0 ploptlst) nil))
39.           (setq ptt (inters (nth k plptlst) (nth k ploptlst) (nth (+ k 1) plptlst) (nth (+ k 1) ploptlst) nil))
40.         )
41.         (if (and ptt (not (eq k (- (length plptlst) 1))) (or (eq (distance (nth k plptlst) ptt) dst) (eq (distance (nth (+ k 1) plptlst) ptt) dst)))
42.           (progn
43.             (setq p ptt)
44.             (vla-addline msp (vlax-3d-point (nth k plptlst)) (vlax-3d-point ptt))
45.             (vla-addline msp (vlax-3d-point (nth (+ k 1) plptlst)) (vlax-3d-point ptt))
46.           )
47.           (if (and ptt (eq k (- (length plptlst) 1)) (or (eq (distance (nth k plptlst) ptt) dst) (eq (distance (nth 0 plptlst) ptt) dst)))
48.             (progn        
49.               (setq p ptt)
50.               (vla-addline msp (vlax-3d-point (nth k plptlst)) (vlax-3d-point ptt))
51.               (vla-addline msp (vlax-3d-point (nth 0 plptlst)) (vlax-3d-point ptt))
52.             )
53.           )
54.         )
55.       )
56.     )
57.   )
58. )
59.  
60. (defun kr (plin / pold plinn pldxf plinptlst)
61.   (setq pold p)
62.   (vl-cmdf "_.offset" "t" plin p "")
63.   (setq plin (entlast))
64.   (setq pldxf (entget plin))
65.   (mapcar '(lambda (x) (if (eq (car x) 10) (setq plinptlst (cons (cdr x) plinptlst)))) pldxf)
66.   (setq plinptlst (reverse plinptlst))
67.   (setq plinptlst (acet-list-remove-duplicates plinptlst 1e-6))
68.   (entdel plin)
69.   (setq plinn (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
70.                                       (cons 90 (length plinptlst))
71.                                      '(70 . 1)
72.                                 )
73.                                 (mapcar '(lambda ( x ) (cons 10 x)) plinptlst)
74.                                 (list '(210 0.0 0.0 1.0))
75.                         )
76.               )
77.   )
78.   (pll plinn)
79.   (if (not (equal pold p 1e-8)) (kr plinn))
80. )
81.  
82. (defun c:kr (/ pl)
83.   (setq pl (car (entsel "\nPick 2d polyline")))
84.   (pll pl)
85.   (kr pl)
86.   (princ)
87. )
88.  

Regards, M.R.

[ribarm]

As this is complicated to program, I watched this video and suddenly everything revealed to be simply built-in AutoCAD... 

This example will surely undercut Lee's business with the code selling... Maybe Lee would change his mind and post the code for learning purposes of us that don't know how to create *.lsp routine for this...

Regards, M.R.

[highflyingbird]

This example will surely undercut Lee's business with the code selling... Maybe Lee would change his mind and post the code for learning purposes of us that don't know how to create *.lsp routine for this...

ribarm,excellent,I will take some time to study your code!

[CAB]

LeeMac has invested considerable time and effort in learning to code well. I think he has every right
to recoup something for his investment.  He has shared his talent freely in many threads so I feel
he has given plenty to our community.

My 2cents 

[chlh_jd]

LeeMac has invested considerable time and effort in learning to code well. I think he has every right
to recoup something for his investment.  He has shared his talent freely in many threads so I feel
he has given plenty to our community.

Me too .

[RGUS]

I have a LISP solution which I believe yields the correct straight skeleton result for 90% of cases, but have not released it as freeware:



Some more examples:

Awesome Lee... so where does one purchase such a cool bit of code?