Author Topic: ==={Challenge}===Find the ridge lines of sloped roof (Read 106877 times)

ribarm · « **Reply #75 on:** February 22, 2014, 10:12:34 AM »

chlh_jd... But to use 2droof3d.lsp, you have to have 2d soultion firstly created... You just selected LWPOLYLINE without 2D solution ridge lines... And I suggest that you use simple 2droof3d.lsp - not the old version... As for the above example, I agree that this HP.lsp solution can be derived from built-in EXTRUDE - TAPER command, but then you'll miss possible other soultions like I showed on left example... Both are correct and more over - to my opinion, left solution is much nicer as in practical possible realization reasons there are no close ridge edges that collapse into top apex... There is much nicer top ridge that is then continued to transform into porche roof mass that is attached to main roof solution...

chlh_jd · « **Reply #76 on:** February 22, 2014, 10:13:56 PM »

Quote from: ribarm on February 22, 2014, 10:12:34 AM

chlh_jd... But to use 2droof3d.lsp, you have to have 2d soultion firstly created... You just selected LWPOLYLINE without 2D solution ridge lines... And I suggest that you use simple 2droof3d.lsp - not the old version... As for the above example, I agree that this HP.lsp solution can be derived from built-in EXTRUDE - TAPER command, but then you'll miss possible other soultions like I showed on left example... Both are correct and more over - to my opinion, left solution is much nicer as in practical possible realization reasons there are no close ridge edges that collapse into top apex... There is much nicer top ridge that is then continued to transform into porche roof mass that is attached to main roof solution...

I'll test 2droof3d.lsp later, I don't think the Left result in your above example is right , just I reply following it . One boundary-line only One Roof-line , I think .

ribarm · « **Reply #77 on:** March 15, 2014, 05:48:41 PM »

2droof3d.lsp has been updated... Removed biggest boundary polyline from possible interaction within last lambda statement... Also previously created regions and lines successfully converted to LWPOLYLINES and removed from active document... (Implemented code from L.M. bbpoly.lsp posted here on this site)

http://www.theswamp.org/index.php?topic=10371.msg514603#msg514603

M.R.

ribarm · « **Reply #78 on:** May 25, 2014, 04:57:37 AM »

Also changed hr.lsp - GP's modified version by me... Little change inside Maximum circumscribed circle subfunction...

chlh_jd · « **Reply #79 on:** May 31, 2014, 05:55:25 AM »

Use Command method dose not run in my computer (Acad2011 & Win7 64Bits)
here's my first version use Ray and Axis to construct roof line .

Code - Auto/Visual Lisp: [Select]

(setq _2pi (+ pi pi)
      _pi2 (/ pi 2.)
      *gsls_debug* nil)
 
(defun ray-inters  (p0 an0 p1 an1 / p)
  ;; intersection of two ray line 
  ;; an0 an1 -- [0 2pi)
  (if (equal (angle p0 p1) an0 5e-5)
    p1
    (if
      (and (setq p (inters p0 (polar p0 an0 1000.) p1 (polar p1 an1 1000.) nil))
           (equal (angle p0 p) an0 5e-5)
           (equal (angle p1 p) an1 5e-5))
       p)))
 
(defun bisetor  (p0 p1 p2 / d a a0)
  ;; Get inter bisetor of counterclockwise point set
  ;; p0 p1 p2 -- 3p of ccw polygon
  ;; return inter-bisetor in [0 2pi)
  (setq d (distance p0 p1)
        a (- (setq a0 (angle p1 p0)) (angle p1 p2))
        a (- a0 (/ (angle '(0 0) (list (* d (cos a)) (* d (sin a)))) 2.)))
  (cond ((< a 0) (+ a _2pi))
        ((>= a _2pi) (- a _2pi))
        (a)))
(defun bisetor2  (p0 p1 p2 p3)
  ;; Get inter bisetor between line (p1 p0) with line (p2 p3) 
  ;; p0 p1 p2 p4-- 4p of ccw polygon
  ;; return inter-bisetor in [0 2pi)
  (setq p0 (mapcar (function +) (mapcar (function -) p2 p1) p0))
  (if
    (<= (car (trans (mapcar (function -) p0 p3) 0 (mapcar (function -) p2 p3))) 0)
     (bisetor p0 p2 p3)
     (bisetor p3 p2 p0)))
;;-----------------------------------------------------
(defun lbisetor  (l / i)
  (setq i -1)
  (mapcar (function (lambda (p0 p1 p2)
                      (setq i (1+ i))
                      (cons i (bisetor p0 p1 p2))))
          (cons (last l) l)
          l
          (append (cdr l) (list (car l)))))
;;
(defun format-i  (i n)
  (cond ((< i 0) (+ n i))
        ((>= i n) (- i n))
        (i)))
 
;;;Function : judge a point location with polygon
;;;Arg : pt -- a point
;;;      pts -- points of polygon
;;;      eps -- allowance
;;;return :
;;;     -1 -- out of polygon , 0 -- at , 1 -- in
(defun pipl?  (pt pts eps / is at a)
  ;; by &#29378;&#20992;  
  ;; Edit by GSLS(SS) 2011.03.28
  ;; Solved the problem : if a point at the given polygon , it perhap return T or NIL .  
  (cond
    ((vl-some (function (lambda (x) (equal x pt eps))) pts) 0)
    ((and
       (equal
         (abs
           (apply
             (function +)
             (mapcar
               (function (lambda (x y / a)
                           (setq a (rem (- (angle pt x) (angle pt y)) PI))
                           (if (equal (+ (distance pt x) (distance pt y))
                                      (distance x y)
                                      Eps)
                             (setq at T))
                           a))
               (cons (last pts) pts)
               pts)))
         pi
         eps)
       (not at))
     1)
    (at 0)
    (-1)))
;; get closed polygon's area
(defun ss-pts2area  (l)
  (/ (apply (function +)
            (mapcar (function (lambda (x y)
                                (- (* (car x) (cadr y)) (* (car y) (cadr x)))))
                    (cons (last l) l)
                    l)) 2.))
;; round
(defun round  (a jd / b s)
  (cond ((numberp a)
         (setq b (expt 10.0 jd)
               s (sign a))
         (/ (fix (+ (* a b) (* 0.5 s))) b))
        ((listp a)
         (mapcar (function (lambda (a) (round a jd))) a))))
;;
(defun sign  (x)
  (cond ((minusp x) -1.)(1.0)))
;;
(defun inzone?  (p p0 an0 p1 an1 / f a an2 an3 d)
  (defun f  (a)
    (cond ((< a 0) (+ a _2pi))
          (a)))
  (setq a   (angle p0 p1)
        an0 (f (- an0 a))
        an1 (f (- an1 a))
        an2 (f (- (angle p0 p) a))
        an3 (f (- (angle p1 p) a))
        d   (car (trans (mapcar (function -) p p1) 0 (mapcar (function -) p0 p1))))
  (and (<= an2 (+ an0 1e-3)) (>= an3 (- an1 1e-3)) (< d 0)))
 ;|
(defun c:test (/ p0 p1 p2 p3 an0 an1 p)
  (setq p0 (getpoint "\nSelect CCW 4 Points -first :")
        p1 (getpoint p0)
        p2 (getpoint p1)
        p3 (getpoint p2)
        an0 (angle p1 p0)
        an1 (angle p2 p3)
        p0 p1 p1 p2)
  (while (setq p (getpoint "\nSelect Determine point :"))
    (if (inzone? p p0 an0 p1 an1)
      (alert "In Zone.")
      (alert "Out Zone."))))
|;
 
(defun c:test  (/ list-inters _Pedal suit-i pnth add-item suit _closed foo foo1 ;_loacal functions
                e pl n i sl bl il rgl tl a b c a1 b1 c1 p p0 p1 p2 p3 closed_n
                closed_il rdl sti fi bi ip0 ip1 j0 j1 rml)
  ;;  Find the ridge lines of sloped roof
  ;;  V0.1  by GSLS(SS)  May 31 , 2014
  ;;  
  ;;------------------------------------local functions------------------------------;;
  ;;
  (defun list-inters  (a b)
    (vl-remove-if-not (function (lambda (x)
                                  (vl-position x a)))
                      b))
  ;;
  (defun _Pedal  (p p1 p2)
    (inters p (polar p (+ _pi2 (angle p1 p2)) 1e3) p1 p2 nil))
  (defun suit-i  (i f)
    (if (not (assoc 70 (nth i rgl)))
      i
      (suit-i (format-i (f i) n) f)))
 
  ;;
  (defun pnth  (a)
    (cond ((= (car a) 10) (nth (cdr a) pl))
          ((nth (cdr a) tl))))
  ;;
  (defun add-item  (ti an chain / a b c d)
    (setq a (car chain)
          b (cadr chain)
          c (cons 11 ti)
          d (cons 12 an))
    (cond ((member c chain)
           (while (not (equal (car chain) c))
             (setq chain (cdr chain)))
           chain)
          ((and an (= (car a) 12))
           (cons (cons 12 an) (cons (cons 11 ti) (cdr chain))))
          ((and (not an) (= (car a) 12))
           (cons (cons 11 ti) (cdr chain)))
          ((= (car a) 11)
           (cond ((= (cdr a) ti)
                  (cons (cons 12 an) chain))
                 ((equal (nth ti tl) (nth (cdr a) tl) 1e-6)
                  (cons (cons 12 an) chain))
                 (chain)))
          (chain)))
  ;;
  (defun suit  (p si / s p1 p2 pp d i ssl)
    (setq s  (nth si sl)
          p1 (nth (car s) pl)
          p2 (nth (cadr s) pl)
          pp (_pedal p p1 p2)
          d  (distance p pp)
          i  -1)
    (setq ssl (vl-remove-if (function (lambda (a)
                                        (setq i (1+ i))
                                        (member i closed_il)))
                            sl))
    (setq sdl
           (mapcar
             (function (lambda (s / p1 p2 an1 an2 pp)
                         (setq p1  (nth (car s) pl)
                               p2  (nth (cadr s) pl)
                               an1 (cdr (assoc (car s) bl))
                               an2 (cdr (assoc (cadr s) bl))
                               pp  (_pedal p p1 p2))
                         (if (or (inzone? p p1 an1 p2 an2)
                                 (equal (distance p1 p2)
                                        (+ (distance p1 pp) (distance p2 pp))
                                        1e-3))
                           (distance p pp)
                           (min (distance p p1) (distance p p2)))))
             ssl))
    (setq sdl (vl-sort sdl '<))
    (not (vl-some (function (lambda (d1) (not (equal d d1 1e-3))))
                  (vl-remove nil (list (car sdl) (cadr sdl) (caddr sdl)))))
    )
  ;; check closed
  (defun _closed  ()
    (if (< closed_n n)
      (setq rgl
             (mapcar
               (function
                 (lambda (r / a b c d e)
                   (setq a (car r)
                         b (cadr r)
                         c (caddr r))
                   (cond
                     (c r)
                     ((and (setq d (assoc 11 a)) (setq e (assoc 11 b)) (equal d e))
                      (setq closed_n  (1+ closed_n)
                            closed_il (cons (cdr (assoc 10 a)) closed_il))
                      (list (member d a) (member e b) (cons 70 1)))
                     ((list a b)))))
               rgl))))
  ;;------------------------------------main routine ------------------------------;;
  (setq e (car (entsel "\nSelect a closed polygon :")))
  (setq pl
         (mapcar (function cdr)
                 (vl-remove-if-not (function (lambda (a) (= (car a) 10))) (entget e))))
  (if (< (ss-pts2area pl) 0) ;_force pointset CCW
    (setq pl (reverse pl)))
  ;; build side message 
  (setq n (length pl)
        i -1)
  (setq sl (mapcar (function (lambda (a)
                               (setq i (1+ i))
                               (if (= (1+ i) n)
                                 (list i 0)
                                 (list i (1+ i)))))
                   pl))
  ;; build inter-bisetor angle list with point index 
  (setq bl (lbisetor pl))
  ;; for test
  (if *gsls_debug* ;_(setq *gsls_debug* T)
    (mapcar (function (lambda (a / p p1)
                        (setq p  (nth (car a) pl)
                              p1 (polar p (cdr a) 500.))
                        (entmake (list (cons 0 "TEXT")
                                       (cons 10 p)
                                       (cons 1 (rtos (car a) 2 0))
                                       (cons 40 1000.)
                                       (cons 41 0.7)
                                       (cons 50 0.0)))
                        (entmake (list (cons 0 "LINE")
                                       (cons 10 p)
                                       (cons 11 p1)
                                       (cons 8 "TEST")
                                       (cons 62 3)))))
            bl))
  ;; build start result list , each side with two construction list
  ;; dxf code : 10 -- point of pl , 11 -- point of tl (inter points) , 12 -- ray angle of last point  , 70 -- closed mark 
  (setq rgl
         (mapcar
           (function
             (lambda (s)
               (list (list (cons 12 (cdr (nth (car s) bl))) (cons 10 (car s)))
                     (list (cons 12 (cdr (nth (cadr s) bl))) (cons 10 (cadr s))))))
           sl))
  ;; find first suitable ray-intersections 
  (setq il
         (vl-remove
           nil
           (mapcar
             (function
               (lambda (s / s1 s2 p i)
                 (setq s1 (nth (car s) bl) ;_(setq s (list 19 20))
                       s2 (nth (cadr s) bl)
                       p  (ray-inters (nth (car s1) pl)
                                      (cdr s1)
                                      (nth (car s2) pl)
                                      (cdr s2)))
                 (if
                   (and
                     p
                     (> (pipl? p pl 1e-6) 0)
                     (suit p (car s)))
                    (list s p))))
             sl)))
  ;; add first suitable intersections into it's side info , put them closed .
  (setq closed_n 0)
  (foreach s  il
    (setq p (round (cadr s) 6))
    (if (not (setq i (vl-position p tl)))
      (setq tl (append tl (list p))
            i  (1- (length tl))))
    (setq b         (nth (caar s) rgl)
          b1        (list (add-item i nil (car b))
                          (add-item i nil (cadr b))
                          (cons 70 1))
          rgl       (subst b1 b rgl)
          closed_n  (1+ closed_n)
          closed_il (cons (caar s) closed_il))
    ;;deal near side info
    (if (and (< closed_n n)
             (setq bi (suit-i (format-i (1- (caar s)) n) 1-))
             (setq fi (suit-i (cadar s) 1+))
             (/= bi fi))
      (setq a   (nth bi rgl)
            c   (nth fi rgl)
            p0  (nth (cdr (assoc 10 (car a))) pl)
            p1  (nth (cdr (assoc 10 (cadr a))) pl)
            p2  (nth (cdr (assoc 10 (car c))) pl)
            p3  (nth (cdr (assoc 10 (cadr c))) pl)
            an  (bisetor2 p0 p1 p2 p3)
            a1  (list (car a) (add-item i an (cadr a)))
            c1  (list (add-item i an (car c)) (cadr c))
            rgl (subst a1 a rgl)
            rgl (subst c1 c rgl))))
  ;; deal has closed side .
  (_closed)
  ;; deal near side of closed-side , until catch another closed side
  (if (< closed_n n)
    (setq rdl (vl-remove-if-not (function (lambda (a) (assoc 70 a))) rgl)
          rdl (mapcar (function (lambda (a / p pp d)
                                  (if (assoc 11 (car a))
                                    (setq p (pnth (assoc 11 (car a))))
                                    (setq p (pnth (assoc 11 (cadr a)))))
                                  (setq pp (_pedal p
                                                   (pnth (assoc 10 (car a)))
                                                   (pnth (assoc 10 (cadr a))))
                                        d  (distance p pp))
                                  (list d a)))
                      rdl)
          rdl (vl-sort rdl
                       (function (lambda (a b)
                                   (< (car a) (car b)))))))
  (defun foo  ()
    (while (and (< closed_n n)
                (/= bi fi)
                (setq a (nth bi rgl))
                (setq c (nth fi rgl))
                (not (assoc 70 a))
                (not (assoc 70 c))
                (vl-remove nil
                           (list (setq ip0 (ray-inters (pnth (cadadr a))
                                                       (cdaadr a)
                                                       (pnth (cadar a))
                                                       (cdaar a)))
                                 (setq ip1 (ray-inters (pnth (cadar c))
                                                       (cdaar c)
                                                       (pnth (cadadr c))
                                                       (cdaadr c)))))
                (setq p (pnth (cadar c)))
                (setq ip
                       (cond
                         ((and ip0 ip1)
                          (cond
                            ((and (> (setq j0 (pipl? ip0 pl 1e-6)) 0)
                                  (> (setq j1 (pipl? ip1 pl 1e-6)) 0))
                             (cond ((<= (distance p ip0) (distance p ip1))
                                    (if (suit ip0 bi)
                                      (cons "back" ip0)))
                                   ((if (suit ip1 fi)
                                      (cons "for" ip1)))))
                            ((> (setq j0 (pipl? ip0 pl 1e-6)) 0)
                             (if (suit ip0 bi)
                               (cons "back" ip0)))
                            ((> (setq j1 (pipl? ip1 pl 1e-6)) 0)
                             (if (suit ip1 fi)
                               (cons "for" ip1)))))
                         ((and ip0 (> (setq j0 (pipl? ip0 pl 1e-6)) 0))
                          (if (suit ip0 bi)
                            (cons "back" ip0)))
                         ((and ip1 (> (setq j1 (pipl? ip1 pl 1e-6)) 0))
                          (if (suit ip1 fi)
                            (cons "for" ip1))))))
      (setq p (round (cdr ip) 6))
      (if (not (setq i (vl-position p tl)))
        (setq tl (append tl (list p))
              i  (1- (length tl))))
      (cond ((= (car ip) "for")
             (setq c1        (list (add-item i nil (car c))
                                   (add-item i nil (cadr c))
                                   (cons 70 1))
                   rgl       (subst c1 c rgl)
                   closed_n  (1+ closed_n)
                   closed_il (cons (cdr (assoc 10 (car c))) closed_il)
                   fi        (format-i (1+ fi) n))
             (if (= (suit-i (format-i fi n) 1+) bi)
               (setq a1        (list (add-item i nil (car a))
                                     (add-item i nil (cadr a))
                                     (cons 70 1))
                     rgl       (subst a1 a rgl)
                     closed_n  (1+ closed_n)
                     closed_il (cons (cdr (assoc 10 (car a))) closed_il))
               (if (setq c (nth (suit-i (format-i fi n) 1+) rgl))
                 (setq p2  (pnth (assoc 10 (car c)))
                       p3  (pnth (assoc 10 (cadr c)))
                       p0  (pnth (assoc 10 (car a)))
                       p1  (pnth (assoc 10 (cadr a)))
                       an  (bisetor2 p0 p1 p2 p3)
                       a1  (list (car a) (add-item i an (cadr a)))
                       rgl (subst a1 a rgl)
                       c1  (list (add-item i an (car c)) (cadr c))
                       rgl (subst c1 c rgl)))))
            ((= (car ip) "back")
             (setq a1        (list (add-item i nil (car a))
                                   (add-item i nil (cadr a))
                                   (cons 70 1))
                   rgl       (subst a1 a rgl)
                   closed_n  (1+ closed_n)
                   closed_il (cons (cdr (assoc 10 (car a))) closed_il)
                   bi        (format-i (1- bi) n))
             (if (= (suit-i (format-i bi n) 1-) fi)
               (setq c1        (list (add-item i nil (car c))
                                     (add-item i nil (cadr c))
                                     (cons 70 1))
                     rgl       (subst c1 c rgl)
                     closed_n  (1+ closed_n)
                     closed_il (cons (cdr (assoc 10 (car c))) closed_il))
               (if (setq a (nth (suit-i (format-i bi n) 1-) rgl))
                 (setq p2  (pnth (assoc 10 (car c)))
                       p3  (pnth (assoc 10 (cadr c)))
                       p0  (pnth (assoc 10 (car a)))
                       p1  (pnth (assoc 10 (cadr a)))
                       an  (bisetor2 p0 p1 p2 p3)
                       a1  (list (car a) (add-item i an (cadr a)))
                       rgl (subst a1 a rgl)
                       c1  (list (add-item i an (car c)) (cadr c))
                       rgl (subst c1 c rgl)))))) ;_cond      
      ))
  ;;
  (foreach s  rdl
    (if (< closed_n n)
      (progn
        (setq sti (cdr (assoc 10 (caadr s))))
        (setq fi (suit-i (format-i (1+ sti) n) 1+)
              bi (suit-i (format-i (1- sti) n) 1-))
        (foo)))) ;_foreach
  ;; check closed  
  (_closed)
  ;; deal other no closed side
  (defun foo1  (a)
    (if (and (setq p (ray-inters (pnth (cadadr a))
                                 (cdaadr a)
                                 (pnth (cadar a))
                                 (cdaar a)))
             (> (pipl? p pl 1e-6) 0)
             (suit p (cdr (assoc 10 (car a)))))
      (progn
        (setq p (round (cdr ip) 6))
        (if (not (setq i (vl-position p tl)))
          (setq tl (append tl (list p))
                i  (1- (length tl))))
        (setq a1        (list (add-item i nil (car a))
                              (add-item i nil (cadr a))
                              (cons 70 1))
              rgl       (subst a1 a rgl)
              closed_n  (1+ closed_n)
              closed_il (cons (cdr (assoc 10 (car a))) closed_il)
              ))
      (if (equal (angle (pnth (cadar a)) (pnth (cadadr a)))
                 (cdaar a)
                 1e-5) ;_collinear
        (setq a1        (list (cons (cadadr a) (cdar a))
                              (cdadr a)
                              (cons 70 1))
              rgl       (subst a1 a rgl)
              closed_n  (1+ closed_n)
              closed_il (cons (cdr (assoc 10 (car a))) closed_il))
        (if (equal (cadadr a) (cadar a))
          (setq a1        (list (cdar a) (cdadr a) (cons 70 1))
                rgl       (subst a1 a rgl)
                closed_n  (1+ closed_n)
                closed_il (cons (cdr (assoc 10 (car a))) closed_il))
          (progn ;_force out routine ... 
            (princ "\n ***Error*** : ...")
            (setq closed_n (1+ closed_n)))
          ))))
  (while (and (< closed_n n)
              (setq rml (vl-remove-if (function (lambda (a) (assoc 70 a))) rgl)))
    (cond
      ((caddr rml)
       (setq il
              (vl-remove
                nil
                (mapcar
                  (function
                    (lambda (a / i p b)
                      (setq i (vl-position a rgl))
                      (if (and (setq p (ray-inters (pnth (cadadr a))
                                                   (cdaadr a)
                                                   (pnth (cadar a))
                                                   (cdaar a)))
                               (> (pipl? p pl 1e-6) 0)
                               (suit p i)
                               (setq b (list (cadar a) (cadadr a))))
                        (list p i))))
                  rml))) ;_
       ;;
       (if il
         (foreach s  il
           (if (< closed_n n)
             (progn
               (setq p (car s)
                     b (nth (cadr s) rgl))
               (if (not (setq i (vl-position p tl)))
                 (setq tl (append tl (list p))
                       i  (1- (length tl))))
               (setq b1        (list (add-item i nil (car b))
                                     (add-item i nil (cadr b))
                                     (cons 70 1))
                     rgl       (subst b1 b rgl)
                     closed_n  (1+ closed_n)
                     closed_il (cons (cdr (assoc 10 (car b))) closed_il))
               (setq fi (suit-i (format-i (1+ (cdr (assoc 10 (car b)))) n) 1+)
                     bi (suit-i (format-i (1- (cdr (assoc 10 (car b)))) n) 1-))
               (setq a   (nth bi rgl)
                     c   (nth fi rgl)
                     p0  (nth (cdr (assoc 10 (car a))) pl)
                     p1  (nth (cdr (assoc 10 (cadr a))) pl)
                     p2  (nth (cdr (assoc 10 (car c))) pl)
                     p3  (nth (cdr (assoc 10 (cadr c))) pl)
                     an  (bisetor2 p0 p1 p2 p3)
                     a1  (list (car a) (add-item i an (cadr a)))
                     c1  (list (add-item i an (car c)) (cadr c))
                     rgl (subst a1 a rgl)
                     rgl (subst c1 c rgl))
               (foo)))
           )
         (mapcar (function foo1) rml) ;_force deal 
         )
       )
      ((mapcar (function foo1) rml))) ;_cond
    (_closed)
    ) ;_while 
  ;; test result
  (foreach r  rgl
    (if (assoc 70 r)
      (mapcar
        (function (lambda (a)
                    (setq b (mapcar (function (lambda (a) (pnth a))) a))
                    (mapcar (function (lambda (c d)
                                        (entmake (list (cons 0 "LINE")
                                                       (cons 10 c)
                                                       (cons 11 d)
                                                       (cons 8 "Proof")
                                                       (cons 62 1)))))
                            b
                            (cdr b))))
        (list (car r) (cadr r)))))
  (princ)
  )
 

ribarm · « **Reply #80 on:** May 31, 2014, 06:38:49 AM »

Very impressive, GSLS(SS)... Still not all cases are solvable... Look into my example DWG...

But thanks for reply, nice coding...

ribarm · « **Reply #81 on:** May 31, 2014, 06:59:03 AM »

Another example...

chlh_jd · « **Reply #82 on:** June 02, 2014, 03:31:13 AM »

Ribar , thank you very much .

I'v changed the routine's loop and some function to do better , but even found a no suit shape pl .
To run routine's , you must download the lisp file .

Code - Auto/Visual Lisp: [Select]

(defun c:test  (/ list-inters _Pedal suit-i used-si pnth add-item suit _closed
                _getclosed _getneighbor _getclosedinfo _closeditself _get_minz
                _getnoclosedpair _getnoclosdedpairinfo foo foo1 foo2 ;_loacal functions
                pl n i% sl bl rgl tl zl closed_n closed_il ;_through variables 
                e i il rdl rnl rml a b c a1 b1 c1 p p0 p1 p2 p3 z sti bi fi ip0 ip1
                j0 j1 sil)
  ;;  Find the ridge lines of sloped roof
  ;;  V0.2  by GSLS(SS)  June 31 , 2014
  ;;  
  ;;------------------------------------local functions------------------------------;;
  ;;
....)
 

ribarm · « **Reply #83 on:** June 02, 2014, 06:04:01 AM »

Hi, chlh_jd... I must say I am very impressed... It almost work in every situation... I don't know why, by my "Another example" didn't finish like you showed on your animated GIF... I am on A2014 and didn't modify file I posted, just checked on the same polyline and it failed around start/end vertex... I've turned off debug mode, removed layer creation of ridge lines - uses current layer and done overkilling duplicate ridges through ALISP... And you showed on very complex example with revcloud some lack... Hope you'll solve this when you did it so good so far... I'll attach your lisp with those mods I mentioned (I don't want duplicate ridges)... Very grateful for this, thanks again GSLS(SS)...

M.R.

GDF · « **Reply #84 on:** June 02, 2014, 10:59:49 AM »

pretty impressive

ribarm · « **Reply #85 on:** June 02, 2014, 02:37:35 PM »

chlh_jd, I've tried to improve, but I don't know if my attempt is good... Now my case is solved, but I don't know ab your (revcloud)... My attempt was pretty simple in comparison to your coding (made main sub-function - "start", and if it runs on error it restarts main function with little modified order of vertices - had to nil rgl variable)... So error should be printed, but solution should be made if my estimations were correct... Also made better formatting of code - never mind it's now bigger...

So long from me for now, M.R.

chlh_jd · « **Reply #86 on:** June 02, 2014, 08:59:42 PM »

Quote from: ribarm on June 02, 2014, 06:04:01 AM

Hi, chlh_jd... I must say I am very impressed... It almost work in every situation... I don't know why, by my "Another example" didn't finish like you showed on your animated GIF... I am on A2014 and didn't modify file I posted, just checked on the same polyline and it failed around start/end vertex... I've turned off debug mode, removed layer creation of ridge lines - uses current layer and done overkilling duplicate ridges through ALISP... And you showed on very complex example with revcloud some lack... Hope you'll solve this when you did it so good so far... I'll attach your lisp with those mods I mentioned (I don't want duplicate ridges)... Very grateful for this, thanks again GSLS(SS)...

M.R.

You are welcome .

Quote from: ribarm on June 02, 2014, 02:37:35 PM

chlh_jd, I've tried to improve, but I don't know if my attempt is good... Now my case is solved, but I don't know ab your (revcloud)... My attempt was pretty simple in comparison to your coding (made main sub-function - "start", and if it runs on error it restarts main function with little modified order of vertices - had to nil rgl variable)... So error should be printed, but solution should be made if my estimations were correct... Also made better formatting of code - never mind it's now bigger...

So long from me for now, M.R.

Ribar , Thank you for test , please post your error polygon for me , thanks .

I've catch the error you said , it's because of the accuracy of AutoCAD's VLIDE .
Even now the most Process of the Algorithm -- through bisector and axis from 2D , you can check every function with precision , and then found which is wrong .
Add change start point , shoud change each side to operate , and it can slove some error cause by precision . In my opinion , change every point's coordinates into according the centroid , and then transform them back after get the result , this method will be some better .

It can be easy modified into support 3D method , because it has Z list , like building each side region and then union them . Enjoy .

ribarm · « **Reply #87 on:** June 03, 2014, 12:31:13 AM »

Quote from: chlh_jd on June 02, 2014, 08:59:42 PM

Ribar , Thank you for test , please post your error polygon for me , thanks .

Here is it - see attachment...

[EDIT] : Also if you plan to use my modified version of your code, change this :

Code: [Select]

          (princ "\n ***Error*** : ...")
          (setq rgl nil)
          (setq err (1+ err))
          (setq pl (cons (last pl) (reverse (cdr (reverse pl)))))
          (if (eq err 1) (start pl))

To this, so it can exchange all points and attempt to solve for each combination :

Code: [Select]

          (princ "\n ***Error*** : ...")
          (setq rgl nil)
          (setq err (1+ err))
          (setq pl (cons (last pl) (reverse (cdr (reverse pl)))))
          (if (< err n) (start pl))

M.R.

chlh_jd · « **Reply #88 on:** June 03, 2014, 05:28:01 AM »

Ribar , this one has fix the bug in the case of the dwg you post
The first closed side vectexs , must determin in the other inzoneside triangle .

Code: [Select]

    ;; if the point in the triangle {pa pb [i0~3]} which construct by the inzone side {pa pb}
    ;;                        and it's bisector rays inters with line {p p1} or line {p p2}  
    ;; SCH. of Invalid ray-inters of side {p1 p2}          	
    ;;	 	        p2___________p1                     	
    ;;  	         \i1       /                       	
    ;; 		        ／＼      /              		
    ;;   	      ／   \＼   /               		
    ;;	      bi_a  ／      \ ＼/                		
    ;; 	       |  ／         \ /＼bi_b           		
    ;;         |／            P   ＼             		
    ;;         pa-------------------pb

ribarm · « **Reply #89 on:** June 03, 2014, 07:18:10 AM »

Congratulations, GSLS... What is the problem then with revcloud? I also have issues with arced polylines... But solving my posted DWG, I hope situation is much better... chlh_jd, do I have to use my attached version to solve posted DWG "Another example" or do you also have some better approach? I'll attach my version of implemented your new solution - this is what I use finally for now... Thanks again... M.R.

[EDIT] : Attached one more case...
[EDIT] : LSP file reattached so that now if solution was found no need for overkill of ridges...
(4 downloads of old version)

News:

Author Topic: ==={Challenge}===Find the ridge lines of sloped roof (Read 106877 times)

ribarm

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

chlh_jd

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

ribarm

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

ribarm

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

chlh_jd

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

ribarm

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

ribarm

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

chlh_jd

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

ribarm

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

GDF

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

ribarm

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

chlh_jd

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

ribarm

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

chlh_jd

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

ribarm

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