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

0 Members and 1 Guest are viewing this topic.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #195 on: January 14, 2021, 04:14:57 AM »
HA, it was just a moment while working on routine... My latest version is finished... tricky roof-passed test in AutoCAD...
With my latest intervention it is also considered LWPOLYLINE that was made from closed MLINE... Previously it didn't worked with those shapes... So everything is working well... If someone notice something, please inform me...
Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #196 on: January 14, 2021, 05:06:04 AM »
It's me again... This one it can't do... ch_lhjd's version is relatively good - better than mine, but I won't debug my code further... I am tired, I leave that to someone fresh...
Bye, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #197 on: January 14, 2021, 02:51:50 PM »
You know what... I'll tell you the secret to gain speed...

Quote
  (defun LM:Inside-p (pt ent / unit v^v _GroupByNum fd1 fd2 par lst nrm obj tmp)
    (vl-load-com)
    (defun unit (v / d)
      (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8))
        (mapcar (function (lambda (x) (/ x d))) v)
      )
    )
    (defun v^v (u v)
      (list
        (- (* (cadr u) (caddr v)) (* (caddr u) (cadr v)))
        (- (* (caddr u) (car v)) (* (car u) (caddr v)))
        (- (* (car u) (cadr v)) (* (cadr u) (car v)))
      )
    )
    (defun _GroupByNum (l n / r)
      (if l
        (cons (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r)) (_GroupByNum l n))
      )
    )
    (if (= (type ent) 'VLA-OBJECT)
      (setq obj ent ent (vlax-vla-object->ename ent))
      (setq obj (vlax-ename->vla-object ent))
    )
    (if (vlax-curve-isplanar ent)
      (progn
        ;(setq fd1 (vlax-curve-getfirstderiv ent (setq par (vlax-curve-getstartparam ent))))
        ;(while (or (equal fd1 (setq fd2 (vlax-curve-getfirstderiv ent (setq par (+ par 0.001)))) 1e-3) (null (setq nrm (unit (v^v fd1 fd2))))))
        (setq nrm '(0.0 0.0 1.0)) ;;; mod by M.R. - gaining speed

        (setq lst
          (_GroupByNum
            (vlax-invoke
              (setq tmp
                (vlax-ename->vla-object
                  (entmakex
                    (list
                      (cons 0 "RAY")
                      (cons 100 "AcDbEntity")
                      (cons 100 "AcDbRay")
                      (cons 10 pt)
                      (cons 11 (trans '(1.0 0.0 0.0) nrm 0))
                    )
                  )
                )
              )
              'IntersectWith obj acextendnone
            ) 3
          )
        )
        (vla-delete tmp)
        ;; gile:
        (and
          lst
          (not (vlax-curve-getparamatpoint ent pt))
          (= 1 (rem (length (vl-remove-if (function (lambda (p / pa p- p+ p0)
                                                      (setq pa (vlax-curve-getparamatpoint ent p))
                                                      (and (setq p- (cond ((setq p- (vlax-curve-getPointatParam ent (- pa 1e-8)))
                                                                           (trans p- 0 nrm)
                                                                          )
                                                                          ((trans (vlax-curve-getPointatParam ent (- (vlax-curve-getEndParam ent) 1e-8)) 0 nrm)
                                                                          )
                                                                    )
                                                           )
                                                           (setq p+ (cond ((setq p+ (vlax-curve-getPointatParam ent (+ pa 1e-8)))
                                                                           (trans p+ 0 nrm)
                                                                          )
                                                                          ((trans (vlax-curve-getPointatParam ent (+ (vlax-curve-getStartParam ent) 1e-8)) 0 nrm)
                                                                          )
                                                                    )
                                                           )
                                                           (setq p0 (trans pt 0 nrm))
                                                           (<= 0 (* (sin (angle p0 p-)) (sin (angle p0 p+)))) ;; LM Mod
                                                      )
                                                    )
                                          ) lst
                            )
                    ) 2
               )
          )
        )
      )
    )
  )
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

d2010

  • Bull Frog
  • Posts: 323
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #198 on: January 15, 2021, 04:41:27 AM »
Nice Job!
Thank you pacman.z80 , paperboy.z80, or postaman.z80
You code-lisp is fantastic, but is huge./ or too complex , for manage and search bugs.
I  fill the source/rinarm.lsp with "z80Spectrum -games-names"
(defun c:2droof ( / nn_unique nn_mid nn_clockwisep nn_insidep nn_processpla
Code - Auto/Visual Lisp: [Select]
  1. /*c2s:
  2.          lw=car(entsel("\nPick a closed polygonal LWPOLYLINE..."));
  3.          sos_z80=read("/");
  4.          if (lw)
  5.            { ti=car(_vl_times());
  6.            gc();
  7.           n=cdr(assoc(90,entget(lw)));
  8.           pl=mapcar(function(cdr),vl.remove_if(function(lambda(xeno_z80(), (car(xeno_z80) != 10))),entget(lw)));
  9.           tl=mapcar(function(lambda(arkanoid_z80(bomberman_x80),lISt(arkanoid_z80,bomberman_x80))),pl,append(cdr(pl),lISt(car(pl))));
  10.           tlo=tl,
  11.           utlo=unioncollinearplaneprints(tlo),
  12.           pla=mapcar(function(lambda(pulsoid_z80(mp),lISt(pulsoid_z80,angle(pulsoid_z80,mp)))),pl,mapcar(function(lambda(arkanods_z80(bomberman_z80),((clockwise_p(car(arkanods_z80),car(bomberman_z80),cadr(bomberman_z80)))?mid(polar(cadr(arkanods_z80),angle(cadr(arkanods_z80),car(arkanods_z80)),-1.0),polar(car(bomberman_z80),angle(car(bomberman_z80),cadr(bomberman_z80)),-1.0)):mid(polar(cadr(arkanods_z80),angle(cadr(arkanods_z80),car(arkanods_z80)),1.0),polar(car(bomberman_z80),angle(car(bomberman_z80),cadr(bomberman_z80)),1.0))))),cons(last(tl),tl),tl));
  13.           plaa=pla
  14.           while(n > 0)
  15.             { if (null(ipll)) ipl=unique(processpla(plaa))
  16.                  else  ipl=unique(processpla(unique(pla)));
  17.  
  18.            if (equal(ipl,iplo,1e-6)) n=0;
  19.          if (fff) { pl=mapcar(function(car),pla);
  20.                      foreach(x,pl){lil=cons(lISt(x,ip),lil);}
  21.                    n=0;
  22.                  };
  23.     else
  24.            { ipo=ip;
  25.              ipldtl=mapcar(function(lambda(postman_z80(),lISt(postman_z80,vl.sort(mapcar(function(lambda(tt(),distp2t(postman_z80,tt))),utlo),function(read("<")))))),ipl);
  26.              ipldtl=mapcar(function(lambda(xeno_z80(),lISt(car(xeno_z80),removedoubles(removesingles(cadr(xeno_z80)))))),ipldtl);
  27.              ipldtl=vl.remove_if(function(lambda(xeno(),null(cadr(xeno)))),ipldtl);
  28.              ipldtl=(ipll)?vl.remove_if(function(lambda(xarax_z80(),_vl_position(car(xarax),ipll,1e-6))),ipldtl):ipldtl;
  29.              ipldtl=mapcar(function(lambda(xtro_z80(),lISt(car(xtro),vl.sort(cadr(xtro_z80),function(read("<")))))),ipldtl);
  30.              ipldtlo=vl.sort(ipldtl,function(lambda(arkanoid_z80(b), (car(cadr(arkanoid_z80)) <car(cadr(b))))));
  31.              ipldtlo=vl.remove_if(function(lambda(xonix_z80(),_vl_position(car(xonix_z80),ipll,1e-6))),ipldtlo);
  32.              ip=car(car(ipldtlo))
  33.              while((!process()  && ipldtlo)) {ipldtlo=cdr(ipldtlo);ip=car(car(ipldtlo))};
  34.              ipp=nil;
  35.              if (ipll) { foreach(y,reverse(pal)){ipp=cons(vl.remove_if_not(function(lambda(xorem_z80(),vl.some(function(lambda(a(),#TrimR() (equal(rem( (a+kpi), (2*kpi)),angle(car(y),xorem_z80),1e-6) ||equal(a,angle(car(y),xorem_z80),1e-6)))),cadr(y)))),mapcar(function(car),vl.remove_if(function(lambda(xorem_z80(),_vl_position(car(xorem_z80),ipll,1e-6))),ipldtl))),ipp);};
  36.                  ipp=apply(function(append),ipp);
  37.              if (ip  && p1p2) ipp=cons(ip,ipp);
  38.              ipp=unique(ipp);
  39.              ipp=mapcar(function(lambda(paperboy_z80(),lISt(paperboy_z80,findipinterschilds(paperboy_z80,pla)))),ipp);
  40.              ipp=vl.remove_if(function(lambda(xevious_z80(),null(cadr(xevious_z80)))),ipp);
  41.              ipp=vl.remove_if(function(lambda(xen_z80(),(vl.some(function(lambda(yeti_z80(),equal(distance(car(xen_z80),car(car(cadr(xen_z80)))), (distance(car(xen_z80),y)+distance(y,car(car(cadr(xen_z80))))),1e-6))),vl.remove_if(function(lambda(z(),equal(z,car(car(cadr(xen_z80))),1e-6))),vl.remove_if(function(lambda(z(),equal(z,car(xen_z80),1e-6))),mapcar(function(car),ipldtl)))) || vl.some(function(lambda(yomp_z80(),equal(distance(car(xen_z80),car(cadr(cadr(xen_z80)))), (distance(car(xen_z80),yomp_z80)+distance(yomp_z80,car(cadr(cadr(xen_z80))))),1e-6))),vl.remove_if(function(lambda(z(),equal(z,car(cadr(cadr(x))),1e-6))),vl.remove_if(function(lambda(z(),equal(z,car(x),1e-6))),mapcar(function(car),ipldtl))))#TrimR() ||       vl.some(function(lambda(yocan_z80(sos_z80,ii),#TrimR() (ii=inters(car(xen_z80),car(car(cadr(xen_z80))),car(yocan_z80),cadr(yocan_z80),t)  &&!equal(ii,car(xen_z80),1e-6)#TrimR() &&       !equal(ii,car(car(cadr(xen_z80))),1e-6)#TrimR() &&       !equal(ii,car(yocan_z80),1e-6)#TrimR() &&       !equal(ii,cadr(yocan_z80),1e-6)))),append(tlo,lil))#TrimR() ||       vl.some(function(lambda(yankee1_z80(sos_z80,ii),#TrimR() (ii=inters(car(xen_z80),car(cadr(cadr(xen_z80))),car(yankee1_z80),cadr(yankee1_z80),t)  &&!equal(ii,car(xen_z80),1e-6)#TrimR() &&       !equal(ii,car(cadr(cadr(xen_z80))),1e-6)#TrimR() &&       !equal(ii,car(yankee1_z80),1e-6)#TrimR() && (! equal(ii,cadr(yankee1_z80),1e-6))))),append(tlo,lil))))),ipp);
  42.              dl=mapcar(function(lambda(yogibear_z80(),car(cadr(car_vl.member_if(function(lambda(xeno_z80(),equal(car(xeno_z80),yogibear_z80,1e-6))),ipldtl))))),mapcar(function(car),ipp));
  43.              ip=(dl)?car(nth(vl.position(car_sort(dl,function(read("<"))),dl),ipp)):ip;
  44.          }
  45.     if (vl.every(function(lambda(xmaze_z80(),equal(ip,inters(car(car(pla)),polar(car(car(pla)),cadr(car(pla)),1.0),car(xmaze_z80),polar(car(xmaze_z80),cadr(xmaze_z80),1.0),nil),1e-6))),cdr(pla)) )
  46.          >fff=t;
  47.        process()
  48.       itt=vl.some(function(lambda(xenon_z80(), if ((equal(distance(ip,car(car(p1p2))), (distance(ip,car(xenon_z80))+distance(car(xenon_z80),car(car(p1p2)))),1e-6) ||equal(distance(ip,car(cadr(p1p2))), (distance(ip,car(x))+distance(car(xenon_z80),car(cadr(p1p2)))),1e-6)) )
  49.              car(xenon_z80),
  50.              vl.remove_if(function(lambda(xenon_z80(),equal(ip,car(xenon_z80),1e-6))),ipp)),
  51.      if (p1p2  && itt)) { ip=itt;process(); };
  52.      if (equal(ipo,ip,1e-6)) n=0;
  53.      d=car(cadr(car_vl.member_if(function(lambda(xonix_z80(),equal(car(xonix_z80),ip,1e-6))),ipldtl)));
  54.      al=nil,a=nil
  55.      if (tt)  && f) tl=vl.remove(tt,tl);
  56.      if (f) { t1=vl.some(function(lambda(xadom_z80(),
  57.               (assoc(car(xadom_z80),lISt(car(p1p2))) || assoc(cadr(xadom_z80),lISt(car(p1p2)))) )?
  58.                xadom_z80:tl);
  59.                t2=vl.some(function(lambda(xtrzth_z80(),(assoc(car(xtrzth_z80),lISt(cadr(p1p2))) ||assoc(cadr(xtrzth_z80),lISt(cadr(p1p2)))) )?xtrzth_z80:tl);
  60.              };
  61.     else
  62.     t1=nil,
  63.     t2=nil;
  64.     if (ip ) ipll=cons(ip,ipll);
  65.     if (t1  && t2#TrimR() &&ip) )
  66.          { if (inters(car(t1),cadr(t1),car(t2),cadr(t2),nil) )
  67.              a=angle(inters(car(t1),cadr(t1),car(t2),cadr(t2),nil),ip);
  68.     else
  69.            a=angle(car(t1),cadr(t1));
  70.          };
  71.    if (a) { pla=cons(lISt(ip,a),pla);
  72.             pla=vl.remove_if(function(lambda(xarax_z80(),equal(car(xarax_z80),car(car(p1p2)),1e-6))),pla),pla=vl.remove_if(function(lambda(xarax_z80(),equal(car(xarax_z80),car(cadr(p1p2)),1e-6))),pla);
  73.             if (car(car(p1p2))) lil=cons(lISt(car(car(p1p2)),ip),lil);
  74.             if (car(cadr(p1p2)) lil=cons(lISt(car(cadr(p1p2)),ip),lil);
  75.             pal=cons(lISt(ip,a)),pal)
  76.            };
  77.            };
  78.     else if (ip  && null(fff))
  79.            { if (car(car(p1p2)) ) lil=cons(lISt(car(car(p1p2)),ip),lil);
  80.              if (car(cadr(p1p2))) lil=cons(lISt(car(cadr(p1p2)),ip),lil);
  81.              p=vl.some(function(lambda(xanthius_z80(),(vl.position(xanthius_z80,plaa))?xanthius_z80:p1p2);
  82.              if (p) { tll=vl.remove_if_not(function(lambda(xarq_z80(),vl.some(function(lambda(y(),_vl_position(p,y,1e-6))),xarq_z80))),tlo);
  83.                       tll=car(vl.remove_if_not(function(lambda(xadom_z80(),#TrimR() (_vl_position(car(xadom_z80),vl.remove(nil,mapcar(function(car),lil)),1e-6)  &&_vl_position(cadr(xadom_z80),vl.remove(nil,mapcar(function(car),lil)),1e-6)))),tll));
  84.                       tl=vl.remove(tll,tl);
  85.                     };
  86.              tll=vl.remove_if_not(function(lambda(xcel_z80(),equal(d,distp2t(ip,xcel_z80),1e-6))),tl);
  87.              txtipl=processtxtipl(tll);
  88.              txtipl=vl.remove_if(function(lambda(xarax_x80(),_vl_position(xarax_x80,pl,1e-6))),txtipl);
  89.              al=mapcar(function(lambda(pacman_z80(),((listp(pacman_z80))?angle(pacman_z80,ip):pacman_z80))),txtipl);
  90.              al=vl.remove_if(function(lambda(xecutor_z80(),#TrimR() (_vl_position(xecutor_z80,mapcar(function(cadr),p1p2),1e-6) ||_vl_position(rem( (xecutor_z80+kpi), (2*kpi)),mapcar(function(cadr),p1p2),1e-6)))),al);
  91.              al=unique(al)
  92.              if (al)
  93.                    { pla=append(mapcar(function(lambda(astroball_z80(),lISt(ip,astroball_z80))),al),pla);
  94.                       pal=cons(lISt(ip,al),pal);
  95.                     };
  96.              pla=vl.remove_if(function(lambda(xeno_z80(),equal(car(xeno_z80),car(car(p1p2)),1e-6))),pla),pla=vl.remove_if(function(lambda(xeno_z80(),equal(car(xeno_z80),car(cadr(p1p2)),1e-6))),pla)
  97.           };
  98.   };
  99.  iplo=ipl;
  100.   };
  101.    lil=vl.remove_if(function(lambda(xenophob_z80(),equal(car(xenophob_z80),cadr(xenophob_z80),1e-6))),lil);
  102.    lil=unique(lil);
  103.    lil=vl.remove_if(function(lambda(xmaze_z80(),vl.some(function(lambda(y(),null(y))),xmaze_z80))),lil);
  104.    lipl=apply(function(append),lil);
  105.    lipl=unique(vl.remove_if(function(lambda(xmas_lud_z80(),#TrimR() ( (length(vl.remove(xmas_lud_z80,lipl)) == (length(lipl)-1)) ||  (length(vl.remove(xmas_lud_z80,lipl)) == (length(lipl)-3))) )),lipl));
  106.    lipl=vl.remove_if(function(lambda(xenoii_z80(),vl.some(function(lambda(li(),#TrimR() (equal(distance(car(li),cadr(li)), (distance(car(li),xenoii_z80)+distance(xenoii_z80,cadr(li))),1e-6)  &&!equal(xenoii_z80,car(li),1e-6)#TrimR() &&       !equal(xenoii_z80,cadr(li),1e-6)))),lil))),lipl);
  107.    lil= (lipl )? cons(lISt(car(lipl),cadr(lipl)),lil):lil;
  108.    lil=vl.remove_if(function(lambda(xavior_z80(),#TrimR() (null(car(xavior_z80)) ||null(cadr(xavior_z80))) )),lil);
  109.    foreach(li,lil){entmake(lISt(cons(0,"LINE"),cons(10,car(li)),cons(11,cadr(li))));
  110.   };
  111.   gc();
  112.   prompt("\nElapsed time : ");
  113.   princ(rtos( (car(_vl_times())-ti),2,20));
  114.   prompt(" milliseconds...");
  115.  };
  116. */
  117.  



%include=arkanods_z80
%include=arkanoid_z80
%include=astroball_z80
%include=mid
%include=pacman_z80
%include=paperboy_z80
%include=postman_z80
%include=pulsoid_z80
%include=xadom_z80
%include=xanthius_z80
%include=xarax_x80
%include=xarax_z80
%include=xarq_z80
%include=xavior_z80
%include=xcel_z80
%include=xecutor_z80
%include=xen_z80
%include=xeno
%include=xeno_z80
%include=xenoii_z80
%include=xenon_z80
%include=xenophob_z80
%include=xevious_z80
%include=xmas_lud_z80
%include=xmaze_z80
%include=xonix_z80
%include=xorem_z80
%include=xtro_z80
%include=xtrzth_z80
%include=yankee1_z80
%include=yeti_z80
%include=yocan_z80
%include=yogibear_z80
%include=yomp_z80

Do you like this myLock of your-lisp?
https://youtu.be/i_FlinBI6ck?t=1435

« Last Edit: January 15, 2021, 09:46:45 AM by d2010 »

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #199 on: January 15, 2021, 05:26:16 AM »
You quoted text that I haven't wrote... You spelled my name wrongly... You are posting gibberish code examples... If you say that my code is not good and helpful, then show us your version in ALISP format - real *.lsp... I am not saying that my version is the best, I showed examples where it won't give results, but I also showed solution for ultimate roof and solution based on my algorithm that differs from built-in offset algorithm... So if you have something useful, we'll be grateful to see it, otherwise I must say that you are spamming this topic that is IMHO very profound and well composed...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Coder

  • Swamp Rat
  • Posts: 827
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #200 on: January 15, 2021, 06:58:51 AM »
You are posting gibberish code examples...
.... I must say that you are spamming this topic that is IMHO very profound and well composed...

I am completely agree with you and all of his posts are real rubbish and has nothing to do with any thread he contributed with since his first post then that leads me to say that he is really a spammer definitely.

Great work by the way Marko.

d2010

  • Bull Frog
  • Posts: 323
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #201 on: January 15, 2021, 08:20:44 AM »
AProgramul tau Lisp este de bun, dar daca tu cresti complexitatea ribarm2droof.lsp, atunci,  in viitor, programul tau nu va avea viitor, deoarece devine
imposibil de corectat/debug-insideo-on-Real-Time. :wideeyed:
Tu gandeste-te daca (sizeof "* ribarm2droof.lsp") dimensiunea lui creste cu m*1ko, atunci tu sa corectezi  real-debug-in dificultatea lui/creste exponential la +65535...
 :-P
« Last Edit: January 15, 2021, 10:27:35 AM by d2010 »

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #202 on: January 19, 2021, 05:21:32 AM »
My latest revision that handles lastly posted DWG is posted here :
http://www.theswamp.org/index.php?topic=41837.msg603111#msg603111

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #203 on: January 19, 2021, 07:23:50 PM »
Agree also where is the Administrators ?
A man who never made a mistake never made anything

wizman

  • Bull Frog
  • Posts: 290
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #204 on: January 19, 2021, 11:07:49 PM »
Agree also where is the Administrators ?

Agree too.  His posts are incomprehensible.
« Last Edit: January 19, 2021, 11:11:19 PM by wizman »

ronjonp

  • Needs a day job
  • Posts: 7526
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #205 on: January 19, 2021, 11:35:14 PM »
AProgramul tau Lisp este de bun, dar daca tu cresti complexitatea ribarm2droof.lsp, atunci,  in viitor, programul tau nu va avea viitor, deoarece devine
imposibil de corectat/debug-insideo-on-Real-Time. :wideeyed:
Tu gandeste-te daca (sizeof "* ribarm2droof.lsp") dimensiunea lui creste cu m*1ko, atunci tu sa corectezi  real-debug-in dificultatea lui/creste exponential la +65535...
 :-P
I agree your posts are hard to follow ... here's a translation to English for those following.
Quote
Your Lisp program is good, but if you increase the complexity of ribarm2droof.lsp, then in the future your program will have no future because it becomes
impossible to correct / debug-insideo-on-Real-Time.
You think if (sizeof "* ribarm2droof.lsp") its size increases by m * 1ko, then you correct real-debug-in its difficulty / increase exponentially to +65535 ...

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #206 on: September 18, 2021, 01:42:41 PM »
Sorry for my late reply...

I just want to inform that I have improved existing routines posted by @chlh_jd... I have debugged it further more and tested and on ultimate roofs examples that are now solvable...
Also I want to mention that I posted my version also in archive, but still it's not so efficient and reliable as existing routine...
Still nevertheless, IMHO it is worh if nothing as a good example of different approach in coding and thinking...

Link for downloading is here :
https://www.cadtutor.net/forum/files/file/36-hipped-roof-routines/

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #207 on: October 09, 2021, 04:33:28 AM »
I've updated archive... Few more files were added...
All relevant suggestions are welcomed...
You can download *.ZIP archive with *.LSP files from the link I posted in my previous reply...

Regards, M.R.

(P.S. Just checked, you may need to be logged on cadtutor to access new update...)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #208 on: June 27, 2022, 11:41:21 PM »
Someone would think this is solved, but is it?

Proof ?
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #209 on: February 27, 2023, 07:04:43 AM »
Hi...
I've started new one that is not so huge...
But it's only beginning - it creates only starting edges - triangles...
So now, if someone could step in and work for finishing, that'll be great...
Reason for my restart is slow behavior with big examples like ultimate roofs...
chlh_jd code is good, but sometimes it can't find correct exit combination and you waited pointlessly...

@Lee, @Daniel, @Gilles, @Evgeniy, @Owen, @Highflybird, ... and others, tell me how to continue, but not to loose speed too much...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:roof ( / *error* online inside-p mid bvecs car-sort dd barycent assocfuzz process unique test chklili loop pairs ss pl pli pll plll lwx lw lwxi lwi vecs li lil )
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (if
  6.       (and
  7.         lwi
  8.         (not (vlax-erased-p lwi))
  9.       )
  10.       (entdel lwi)
  11.     )
  12.     (if m
  13.       (prompt m)
  14.     )
  15.     (princ)
  16.   )
  17.  
  18.   (defun online ( p1 p2 p3 )
  19.     (equal (distance p1 p3) (+ (distance p1 p2) (distance p2 p3)) 1e-6)
  20.   )
  21.  
  22.   (defun inside-p ( p )
  23.   )
  24.  
  25.   (defun mid ( p1 p2 )
  26.     (mapcar
  27.       (function (lambda ( a b )
  28.         (/ (+ a b) 2.0)
  29.       ))
  30.       p1
  31.       p2
  32.     )
  33.   )
  34.  
  35.   (defun bvecs ( pl pli d )
  36.     (if (not pairs)
  37.       (setq pairs
  38.         (mapcar
  39.           (function (lambda ( a b )
  40.             (list a b)
  41.           ))
  42.           pl
  43.           (append (cdr pl) (list (car pl)))
  44.         )
  45.       )
  46.     )
  47.     (if pli
  48.       (setq vecs
  49.         (mapcar
  50.           (function (lambda ( x y )
  51.             (list x (polar x (angle x y) d))
  52.           ))
  53.           pl
  54.           pli
  55.         )
  56.       )
  57.     )
  58.     vecs
  59.   )
  60.  
  61.   (defun car-sort ( lst cmp / rtn )
  62.     (setq rtn (car lst))
  63.     (foreach itm (cdr lst)
  64.       (if (apply cmp (list itm rtn))
  65.         (setq rtn itm)
  66.       )
  67.     )
  68.     rtn
  69.   )
  70.  
  71.   (defun dd ( p / dl )
  72.     (foreach tt pairs
  73.       (setq dl
  74.         (cons
  75.           (distance
  76.             (mapcar (function +) (list 0.0 0.0) (trans p 1 (mapcar (function -) (cadr tt) (car tt))))
  77.             (mapcar (function +) (list 0.0 0.0) (trans (car tt) 1 (mapcar (function -) (cadr tt) (car tt))))
  78.           )
  79.           dl
  80.         )
  81.       )
  82.     )
  83.     dl
  84.   )
  85.  
  86.   (defun barycent ( pl )
  87.     (mapcar (function /)
  88.       (apply (function mapcar)
  89.         (cons (function +)
  90.           pl
  91.         )
  92.       )
  93.       (list (length pl) (length pl) (length pl))
  94.     )
  95.   )
  96.  
  97.   (defun assocfuzz ( itm lst fuzz )
  98.     (vl-some
  99.       (function (lambda ( x )
  100.         (if (equal itm (car x) fuzz) x)
  101.       ))
  102.       lst
  103.     )
  104.   )
  105.  
  106.   (defun process ( pl pli d / ips pln ii )
  107.     (if (not vecs)
  108.       (progn
  109.         (setq vecs
  110.           (bvecs pl pli d)
  111.         )
  112.         (setq vecs
  113.           (cons (last vecs)
  114.             (reverse
  115.               (cdr
  116.                 (reverse vecs)
  117.               )
  118.             )
  119.           )
  120.         )
  121.       )
  122.     )
  123.     (setq ipss
  124.       (mapcar
  125.         (function (lambda ( a b )
  126.           (list (car a) (cadr a) (inters (car a) (cadr a) (car b) (cadr b) nil) (car b) (cadr b))
  127.         ))
  128.         vecs
  129.         (append (cdr vecs) (list (car vecs)))
  130.       )
  131.     )
  132.     (setq ipss (vl-remove-if (function (lambda ( x ) (null (caddr x)))) ipss))
  133.     (setq ipss
  134.       (vl-remove-if
  135.         (function (lambda ( x / ddd )
  136.           (or
  137.             (not (inside-p (caddr x)))
  138.             (> 2 (- (length (setq ddd (dd (caddr x)))) (length (unique ddd))))
  139.             (vl-some
  140.               (function (lambda ( y )
  141.                 (online (car x) (caddr y) (caddr x))
  142.               ))
  143.               (vl-remove x ipss)
  144.             )
  145.           )
  146.         ))
  147.         ipss
  148.       )
  149.     )
  150.     (foreach ip ipss
  151.       (setq
  152.         lil
  153.         (cons
  154.           (list (car ip) (caddr ip))
  155.           lil
  156.         )
  157.         lil
  158.         (cons
  159.           (list (cadddr ip) (caddr ip))
  160.           lil
  161.         )
  162.       )
  163.       (while
  164.         (setq li
  165.           (vl-some
  166.             (function (lambda ( lii )
  167.               (if
  168.                 (and
  169.                   (online (car lii) (caddr ip) (cadr lii))
  170.                   (not (equal (car lii) (caddr ip) 1e-6))
  171.                   (not (equal (caddr ip) (cadr lii) 1e-6))
  172.                 )
  173.                 lii
  174.               )
  175.             ))
  176.             lil
  177.           )
  178.         )
  179.         (setq lil (vl-remove-if (function (lambda ( x ) (equal (cadr x) (cadr li) 1e-6))) lil))
  180.       )
  181.       (setq vecs (vl-remove (assocfuzz (car ip) vecs 1e-2) vecs))
  182.       (setq vecs (vl-remove (assocfuzz (cadddr ip) vecs 1e-2) vecs))
  183.       (setq
  184.         vecs
  185.         (cond
  186.           ( (and (/= 0 (vl-position (caddr ip) (mapcar (function caddr) ipss))) (/= (length pairs) (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss)))))
  187.             (append
  188.               (list
  189.                 (list
  190.                   (caddr ip)
  191.                   (polar (caddr ip)
  192.                     (if
  193.                       (setq ii
  194.                         (inters
  195.                           (car (nth (1- (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  196.                           (cadr (nth (1- (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  197.                           (car (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  198.                           (cadr (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  199.                           nil
  200.                         )
  201.                       )
  202.                       (angle ii (caddr ip))
  203.                       (angle
  204.                         (barycent
  205.                           (list
  206.                             (car (nth (1- (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  207.                             (cadr (nth (1- (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  208.                             (car (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  209.                             (cadr (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  210.                           )
  211.                         ) (caddr ip)
  212.                       )
  213.                     )
  214.                     d
  215.                   )
  216.                 )
  217.               )
  218.               vecs
  219.             )
  220.           )
  221.           ( (= 0 (vl-position (caddr ip) (mapcar (function caddr) ipss)))
  222.             (append
  223.               (list
  224.                 (list
  225.                   (caddr ip)
  226.                   (polar (caddr ip)
  227.                     (if
  228.                       (setq ii
  229.                         (inters
  230.                           (car (last pairs))
  231.                           (cadr (last pairs))
  232.                           (car (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  233.                           (cadr (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  234.                           nil
  235.                         )
  236.                       )
  237.                       (angle ii (caddr ip))
  238.                       (angle
  239.                         (barycent
  240.                           (list
  241.                             (car (last pairs))
  242.                             (cadr (last pairs))
  243.                             (car (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  244.                             (cadr (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  245.                           )
  246.                         ) (caddr ip)
  247.                       )
  248.                     )
  249.                     d
  250.                   )
  251.                 )
  252.               )
  253.               vecs
  254.             )
  255.           )
  256.           ( (= (length pairs) (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))))
  257.             (append
  258.               (list
  259.                 (list
  260.                   (caddr ip)
  261.                   (polar (caddr ip)
  262.                     (if
  263.                       (setq ii
  264.                         (inters
  265.                           (car (nth (1- (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  266.                           (cadr (nth (1- (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  267.                           (car (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) (append pairs pairs)))
  268.                           (cadr (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) (append pairs pairs)))
  269.                           nil
  270.                         )
  271.                       )
  272.                       (angle ii (caddr ip))
  273.                       (angle
  274.                         (barycent
  275.                           (list
  276.                             (car (nth (1- (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  277.                             (cadr (nth (1- (vl-position (caddr ip) (mapcar (function caddr) ipss))) pairs))
  278.                             (car (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) (append pairs pairs)))
  279.                             (cadr (nth (1+ (vl-position (caddr ip) (mapcar (function caddr) ipss))) (append pairs pairs)))
  280.                           )
  281.                         ) (caddr ip)
  282.                       )
  283.                     )
  284.                     d
  285.                   )
  286.                 )
  287.               )
  288.               vecs
  289.             )
  290.           )
  291.         )
  292.       )
  293.       (if (assocfuzz (car ip) vecs 1e-6)
  294.         (setq vecs (vl-remove-if (function (lambda ( x ) (equal (car x) (car ip) 1e-6))) vecs))
  295.       )
  296.       (if (assocfuzz (cadddr ip) vecs 1e-6)
  297.         (setq vecs (vl-remove-if (function (lambda ( x ) (equal (car x) (cadddr ip) 1e-6))) vecs))
  298.       )
  299.     )
  300.     (mapcar (function car) vecs)
  301.   )
  302.  
  303.   (defun unique ( lst / a ll )
  304.     (while (setq a (car lst))
  305.       (if (vl-some (function (lambda ( x ) (equal x a 1e-6))) (cdr lst))
  306.         (setq ll (cons a ll) lst (vl-remove-if (function (lambda ( x ) (equal x a 1e-6))) (cdr lst)))
  307.         (setq ll (cons a ll) lst (cdr lst))
  308.       )
  309.     )
  310.     (reverse ll)
  311.   )
  312.  
  313.   (defun test nil
  314.     (and
  315.       (vl-every
  316.         (function (lambda ( x )
  317.           (vl-some
  318.             (function (lambda ( y )
  319.               (equal x y 1e-6)
  320.             ))
  321.             (apply (function append) lil)
  322.           )
  323.         ))
  324.         pl
  325.       )
  326.       (not
  327.         (vl-some
  328.           (function (lambda ( li1 )
  329.             (vl-some
  330.               (function (lambda ( li2 / ip )
  331.                 (and
  332.                   (setq ip (inters (car li1) (cadr li1) (car li2) (cadr li2)))
  333.                   (not (equal ip (car li1) 1e-6))
  334.                   (not (equal ip (cadr li1) 1e-6))
  335.                   (not (equal ip (car li2) 1e-6))
  336.                   (not (equal ip (cadr li2) 1e-6))
  337.                 )
  338.               ))
  339.               (vl-remove li1 lil)
  340.             )
  341.           ))
  342.           lil
  343.         )
  344.       )
  345.     )
  346.   )
  347.  
  348.   (defun chklili ( lil / lilpts )
  349.     (setq lilpts (apply (function append) lil))
  350.     (setq lilpts (vl-remove-if-not (function (lambda ( x ) (= (length (vl-remove-if (function (lambda ( y ) (equal x y 1e-6))) lilpts)) (- (length lilpts) 2)))) lilpts))
  351.     lilpts
  352.   )
  353.  
  354.   (prompt "\nPick closed polygonal LWPOLYLINE...")
  355.   (if
  356.     (setq ss
  357.       (ssget "_+.:E:S" (list (cons 0 "LWPOLYLINE") (cons -4 "&=") (cons 70 1) (cons -4 "<not") (cons -4 "<>") (cons 42 0.0) (cons -4 "not>")))
  358.     )
  359.     (progn
  360.       (setq pl
  361.         (mapcar (function cdr)
  362.           (vl-remove-if
  363.             (function (lambda ( x )
  364.               (/= (car x) 10)
  365.             ))
  366.             (setq lwx
  367.               (entget
  368.                 (setq lw
  369.                   (ssname ss 0)
  370.                 )
  371.               )
  372.             )
  373.           )
  374.         )
  375.       )
  376.       (setq lwi (vlax-vla-object->ename (car (vlax-invoke (vlax-ename->vla-object lw) 'offset 1e-2))))
  377.       (if (> (vlax-curve-getarea lwi) (vlax-curve-getarea lw))
  378.         (progn
  379.           (entdel lwi)
  380.           (setq lwi (vlax-vla-object->ename (car (vlax-invoke (vlax-ename->vla-object lw) 'offset -1e-2))))
  381.         )
  382.       )
  383.       (setq pli
  384.         (mapcar (function cdr)
  385.           (vl-remove-if
  386.             (function (lambda ( x )
  387.               (/= (car x) 10)
  388.             ))
  389.             (setq lwxi
  390.               (entget lwi)
  391.             )
  392.           )
  393.         )
  394.       )
  395.       (setq loop t)
  396.       (while (and loop (setq pll (process pl pli 1.0)))
  397.         (if
  398.           (or
  399.             ;(test)
  400.             ;(not (chklili lil))
  401.             (<= (cdr (assoc 90 lwx)) (length lil))
  402.             (equal pll plll 1e-6)
  403.           )
  404.           (setq loop nil)
  405.         )
  406.         (setq plll pll pli nil)
  407.       )
  408.       (foreach li lil
  409.         (entmake
  410.           (list
  411.             (cons 0 "LINE")
  412.             (cons 10 (car li))
  413.             (cons 11 (cadr li))
  414.           )
  415.         )
  416.       )
  417.     )
  418.   )
  419.   (*error* nil)
  420. )
  421.  

Regards, M.R.
« Last Edit: February 28, 2023, 08:38:20 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube