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

BIGAL · « **Reply #255 on:** December 30, 2023, 05:55:47 PM »

I downloaded the roof2d-new-new-solutions.lsp it has "(defun Vl-sort" twice I think second needs to be maybe Vl-sorti ?

Not sure what 1st Vl-sort is doing, I have a sort done by others that allows any number of sort elements used for sorting lists. Very fast.

I have no idea if (nth x lst) is faster than (cadr lst) etc but every millisecond adds up.

ribarm · « **Reply #256 on:** December 31, 2023, 09:05:30 AM »

@BIGAL,

Please refer to this topic for (vl-sort) issue : https://www.theswamp.org/index.php?topic=58952.0
When coded for (vl-sort), vl-sort that is coded has higher priority than built-in (vl-sort)... I only left my version previously named (_vl-sort) in case that someone that is coding for vl-sort in Object Arx, or Dot Net can actually find it useful...

P.S. Since you downloaded only *-solutions.lsp, you firstly have to have single solution to make *-solutions.lsp avoid that case... It's not you have to download all, but roof2d-new-new-new.lsp should give you that single solution, or 2droof-final.lsp, or roof2d-new-new.lsp and from practical reasons I strongly suggest that you download complete package for HIPPED ROOFS at www.cadtutor.net download section : https://www.cadtutor.net/forum/files/file/36-hipped-roof-routines/

ribarm · « **Reply #257 on:** January 04, 2024, 01:40:40 PM »

Here is the version I recently started over again... It matches the speed I need, but unfortunately if throws giberish of lines and the way I coded it is supposed to do on non-ortho hipped roofs... The main problem lies from line 470 to the end... So if someone is willing to help he/she is welcomed...

Code - Auto/Visual Lisp: [Select]

(defun c:roof ( / *error* func wcs initvalueslst ucsf unit rlw unioncollinearplaneprints unique car-sort inside-p distp2t vl-sort numbpos ti s dm lw lwi pl pli tl utl lst ll lll x y ip ips ipss pos ang d1 d2 d t1 t2 tt k done flag f lil )
 
  (defun *error* ( m )
    (foreach li (unique lil)
      (if (and (car li) (cadr li) (not (equal (car li) (cadr li) 1e-6)))
        (entmake (list (cons 0 "LINE") (cons 10 (car li)) (cons 11 (cadr li))))
      )
    )
    (if (and lwi (not (vlax-erased-p lwi)))
      (if (= (type lwi) (quote ename))
        (entdel lwi)
        (vla-delete lwi)
      )
    )
    (if wcs
      (if ucsf
        (while
          (not
            (and
              (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6)
              (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6)
              (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6)
            )
          )
          (exe (list "_.UCS" "_P"))
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (foreach fun (list (quote func) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
      (setq fun nil)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )
 
  (defun func ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;
 
    (defun vl-load nil
      (or cad
        (if vlax-get-acad-object
          (setq cad (vlax-get-acad-object))
          (progn
            (vl-load-com)
            (setq cad (vlax-get-acad-object))
          )
        )
      )
      (or doc (setq doc (vla-get-activedocument cad)))
      (or alo (setq alo (vla-get-activelayout doc)))
      (or spc (setq spc (vla-get-block alo)))
    )
 
    ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
    (or (and cad doc alo spc) (vl-load))
 
    (defun exe ( tokenslist )
      ( (lambda ( tokenslist / ctch )
          (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
            (progn
              (cmderr tokenslist)
              (catch_cont ctch)
            )
            (progn
              (while (< 0 (getvar (quote cmdactive)))
                (vl-cmdf "")
              )
              t
            )
          )
        )
        tokenslist
      )
    )
 
    (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
      (if command-s
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
            ctch
          )
        )
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
            ctch
          )
        )
      )
    )
 
    (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
      (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
    )
 
    (defun catch_cont ( ctch / gr )
      (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
      (while
        (and
          (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
          (setq gr (grread))
          (/= (car gr) 3)
          (not (equal gr (list 2 13)))
        )
      )
      (if (vl-catch-all-error-p ctch)
        ctch
      )
    )
 
    (defun apply_cadr->car ( sysvarvaluepair / ctch )
      (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
      (if (vl-catch-all-error-p ctch)
        (progn
          (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
          (catch_cont ctch)
        )
      )
    )
 
    (defun ftoa ( n / m a s b )
      (if (numberp n)
        (progn
          (setq m (fix ((if (< n 0) - +) n 1e-8)))
          (setq a (abs (- n m)))
          (setq m (itoa m))
          (setq s "")
          (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
            (setq s (strcat s (itoa b)))
            (setq a (- (* a 10.0) b))
          )
          (if (= (type n) (quote int))
            m
            (if (= s "")
              m
              (if (and (= m "0") (< n 0))
                (strcat "-" m "." s)
                (strcat m "." s)
              )
            )
          )
        )
      )
    )
 
    (setq sysvarpreset
      (list
        (list (quote cmdecho) 0)
        (list (quote 3dosmode) 0)
        (list (quote osmode) 0)
        (list (quote unitmode) 0)
        (list (quote cmddia) 0)
        (list (quote ucsvp) 0)
        (list (quote ucsortho) 0)
        (list (quote projmode) 0)
        (list (quote orbitautotarget) 0)
        (list (quote insunits) 0)
        (list (quote hpseparate) 0)
        (list (quote hpgaptol) 0)
        (list (quote halogap) 0)
        (list (quote edgemode) 0)
        (list (quote pickdrag) 0)
        (list (quote qtextmode) 0)
        (list (quote dragsnap) 0)
        (list (quote angdir) 0)
        (list (quote aunits) 0)
        (list (quote limcheck) 0)
        (list (quote gridmode) 0)
        (list (quote nomutt) 0)
        (list (quote apbox) 0)
        (list (quote attdia) 0)
        (list (quote blipmode) 0)
        (list (quote copymode) 0)
        (list (quote circlerad) 0.0)
        (list (quote filletrad) 0.0)
        (list (quote filedia) 1)
        (list (quote autosnap) 1)
        (list (quote objectisolationmode) 1)
        (list (quote highlight) 1)
        (list (quote lispinit) 1)
        (list (quote layerpmode) 1)
        (list (quote fillmode) 1)
        (list (quote dragmodeinterrupt) 1)
        (list (quote dispsilh) 1)
        (list (quote fielddisplay) 1)
        (list (quote deletetool) 1)
        (list (quote delobj) 1)
        (list (quote dblclkedit) 1)
        (list (quote attreq) 1)
        (list (quote explmode) 1)
        (list (quote frameselection) 1)
        (list (quote ltgapselection) 1)
        (list (quote pickfirst) 1)
        (list (quote plinegen) 1)
        (list (quote plinetype) 1)
        (list (quote peditaccept) 1)
        (list (quote solidcheck) 1)
        (list (quote visretain) 1)
        (list (quote regenmode) 1)
        (list (quote celtscale) 1.0)
        (list (quote ltscale) 1.0)
        (list (quote osnapcoord) 2)
        (list (quote grips) 2)
        (list (quote dragmode) 2)
        (list (quote lunits) 2)
        (list (quote pickstyle) 3)
        (list (quote navvcubedisplay) 3)
        (list (quote pickauto) 3)
        (list (quote draworderctl) 3)
        (list (quote expert) 5)
        (list (quote auprec) 6)
        (list (quote luprec) 6)
        (list (quote pickbox) 6)
        (list (quote aperture) 6)
        (list (quote osoptions) 7)
        (list (quote dimzin) 8)
        (list (quote pdmode) 35)
        (list (quote pdsize) -1.5)
        (list (quote celweight) -1)
        (list (quote cecolor) "BYLAYER")
        (list (quote celtype) "ByLayer")
        (list (quote clayer) "0")
      )
    )
    (setq sysvarlst (mapcar (function car) sysvarpreset))
    (setq sysvarvals (mapcar (function cadr) sysvarpreset))
    (setq sysvarvals
      (vl-remove nil
        (mapcar
          (function (lambda ( x )
            (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
          ))
          sysvarlst
        )
      )
    )
    (setq sysvarlst
      (vl-remove-if-not
        (function (lambda ( x )
          (getvar x)
        ))
        sysvarlst
      )
    )
    (setq initvalueslst
      (apply (function mapcar)
        (cons (function list)
          (list
            sysvarlst
            (mapcar (function getvar) sysvarlst)
          )
        )
      )
    )
    (apply (function mapcar)
      (cons (function setvar)
        (list
          sysvarlst
          sysvarvals
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if (not (exe (list "_.UNDO" "_M")))
      (if doc
        (vla-startundomark doc)
      )
    )
    (if wcs
      (if (= 0 (getvar (quote worlducs)))
        (progn
          (setq ucsf
            (list
              (getvar (quote ucsxdir))
              (getvar (quote ucsydir))
              (trans (list 0.0 0.0 1.0) 1 0 t)
            )
          )
          (exe (list "_.UCS" "_W"))
        )
      )
    )
    wcs
  )
 
  (defun unit ( v / d )
    (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-6))
      (mapcar '(lambda ( x ) (/ x d)) v)
    )
  )
 
  (defun rlw ( lw / e x1 x2 x3 x4 x5 x6 )
    ;; by ElpanovEvgeniy
    (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
      (progn
        (foreach a1 e
          (cond
            ( (= (car a1) 10) (setq x2 (cons a1 x2)) )
            ( (= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)) )
            ( (= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)) )
            ( (= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)) )
            ( (= (car a1) 210) (setq x6 (cons a1 x6)) )
            ( t (setq x1 (cons a1 x1)) )
          )
        )
        (entmod
          (append (reverse x1)
            (append
              (apply 'append
                (apply 'mapcar
                  (cons 'list
                    (list x2
                      (cdr (reverse (cons (car x3) (reverse x3))))
                      (cdr (reverse (cons (car x4) (reverse x4))))
                      (cdr (reverse (cons (car x5) (reverse x5))))
                    )
                  )
                )
              )
              x6
            )
          )
        )
        (entupd lw)
      )
    )
  )
 
  (defun unioncollinearplaneprints ( tl / a b tll )
    (while (setq a (car tl))
      (setq b (vl-remove-if-not (function (lambda ( x ) (and (collinear-pp (car a) (cadr a) (car x)) (collinear-pp (car a) (cadr a) (cadr x))))) tl))
      (setq tll (cons a tll))
      (if b
        (setq tl (vl-remove-if (function (lambda ( x ) (vl-some (function (lambda ( y ) (equal x y 1e-6))) b))) tl))
        (setq tl (cdr tl))
      )
    )
    tll
  )
 
  (defun unique ( lst / a ll )
    (while (setq a (car lst))
      (if (vl-some (function (lambda ( x ) (equal x a 1e-6))) (cdr lst))
        (setq ll (cons a ll) lst (vl-remove-if (function (lambda ( x ) (equal x a 1e-6))) (cdr lst)))
        (setq ll (cons a ll) lst (cdr lst))
      )
    )
    (reverse ll)
  )
 
  (defun car-sort ( lst cmp / rtn )
    (setq rtn (car lst))
    (foreach itm (cdr lst)
      (if (apply cmp (list itm rtn))
        (setq rtn itm)
      )
    )
    rtn
  )
 
  (defun inside-p ( p lw lwi )
    (< (distance p (vlax-curve-getclosestpointto lwi p)) (distance p (vlax-curve-getclosestpointto lw p)))
  )
 
  (defun distp2t ( p gg / i d )
    (if (setq i (inters p (polar p (+ (angle (car gg) (cadr gg)) (* 0.5 pi)) 1.0) (car gg) (cadr gg) nil))
      (setq d (distance p i))
    )
  )
 
  (defun vl-sort ( lst func )
    (mapcar
      (function (lambda ( x ) (nth x lst)))
      (vl-sort-i lst func)
    )
  )
 
  (defun numbpos ( n len )
    (cond
      ( (< n len)
        n
      )
      ( (> n len)
        (- n len)
      )
      ( t 0 )
    )
  )
 
  (setq wcs (func t)) ;;; starting "library" template sub function - initialization ;;;
  (prompt "\nPick closed polygonal LWPOLYLINE on unlocked layer...")
  (if (setq s (ssget "_+.:E:S:L" (list (cons 0 "LWPOLYLINE") (cons -4 "&=") (cons 70 1) (cons -4 "<not") (cons -4 "<>") (cons 42 0.0) (cons -4 "not>"))))
    (progn
      (setq ti (car (_vl-times)))
      (setq dm 1e+308)
      (setq lw (ssname s 0))
      (vlax-invoke (vlax-ename->vla-object lw) (quote offset) -1e-3)
      (setq lwi (entlast))
      (if (> (vlax-curve-getarea lwi) (vlax-curve-getarea lw))
        (progn
          (rlw lw)
          (entdel lwi)
          (vlax-invoke (vlax-ename->vla-object lw) (quote offset) -1e-3)
          (setq lwi (entlast))
        )
      )
      (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw))))
      (setq pli (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lwi))))
      (while (not (equal (car pl) (car pli) 0.1))
        (setq pli (append (cdr pli) (list (car pli))))
      )
      (setq tl (mapcar (function (lambda ( a b ) (list a b))) pl (append (cdr pl) (list (car pl)))))
      ;(setq utl (unioncollinearplaneprints tl))
      (setq lst (mapcar (function (lambda ( a b c d ) (list a (angle a b) c d))) pl pli (cons (last tl) (reverse (cdr (reverse tl)))) tl))
      (while (not done)
        (if (not flag)
          (progn
            (setq ll lst ips nil dm 1e+308)
            (while (setq x (car ll))
              (setq ll (cdr ll))
              (setq y (car ll))
              (if (and x y (setq ip (inters (car x) (polar (car x) (cadr x) 1.0) (car y) (polar (car y) (cadr y) 1.0) nil)) (inside-p ip lw lwi))
                (if (< (setq d (min (distp2t ip (caddr x)) (distp2t ip (last y)))) dm)
                  (setq ips (list ip x y) dm d)
                )
              )
            )
            (setq pos (vl-position (cadr ips) lst))
            (if pos
              (repeat (numbpos pos (length pl))
                (setq lst (append (cdr lst) (list (car lst))))
              )
            )
            (setq tt (vl-remove-if (function (lambda ( x ) (= (length (vl-remove-if (function (lambda ( y ) (equal x y 1e-6))) (list (caddr (cadr ips)) (cadddr (cadr ips)) (caddr (caddr ips)) (cadddr (caddr ips))))) 2))) (list (caddr (cadr ips)) (cadddr (cadr ips)) (caddr (caddr ips)) (cadddr (caddr ips)))))
            ;(setq tl (vl-remove (car (vl-remove-if (function (lambda ( x ) (vl-some (function (lambda ( y ) (equal x y 1e-6))) tt))) (list (caddr (cadr ips)) (cadddr (cadr ips)) (caddr (caddr ips)) (cadddr (caddr ips))))) tl))
            (if (and (car ips) (car (cadr ips)) (car (caddr ips)))
              (setq lil (cons (list (car ips) (car (cadr ips))) lil) lil (cons (list (car ips) (car (caddr ips))) lil))
            )
            (setq ang (angle (car ips) (inters (caar tt) (cadar tt) (caadr tt) (cadadr tt) nil)))
            (setq lst (cons (setq ips (list (car ips) ang (car tt) (cadr tt))) lst))
          )
        )
        (setq flag t)
        (setq ll lst dm 1e+308)
        (setq x (assoc (caar lil) ll))
        (setq ll (vl-remove x ll))
        (while (setq y (car ll))
          (setq ll (cdr ll))
          (if (and x y (setq ip (inters (car x) (polar (car x) (cadr x) 1.0) (car y) (polar (car y) (cadr y) 1.0) nil)))
            (if (and (not (equal (setq d (distance ip (caar lil))) 0.0 1e-6)) (< d dm) (inside-p ip lw lwi))
              (setq ips (list ip x y) dm d)
            )
          )
        )
        (setq pos (vl-position (list (cadadr lil) (cadar lil)) tl))
        (setq tl (vl-remove (list (cadadr lil) (cadar lil)) tl))
        (if (and pos (not f))
          (repeat (numbpos pos (length pl))
            (setq lst (append (cdr lst) (list (car lst))))
            (setq tl (append (cdr tl) (list (car tl))))
          )
        )
        (setq f t)
        (setq tt (vl-some (function (lambda ( x ) (if (member x (last tl)) (last tl)))) (mapcar (function cadr) lil)))
        (setq tl (vl-remove tt tl))
        (setq t1 (car tl))
        (setq t2 (last tl))
        (if tl
          (progn
            (setq ang (angle (car ips) (inters (car t1) (cadr t1) (car t2) (cadr t2) nil)))
            (setq ips (list (car ips) ang t1 t2))
            (setq lst (cons ips lst))
            (setq lil (cons (list (car ips) (caar lil)) lil))
            (foreach l lst
              (if (equal (angle (car l) (car ips)) (cadr l) 1e-6)
                (setq lil (cons (list (car ips) (car l)) lil))
              )
            )
          )
        )
        (if (not k)
          (setq k 1)
          (setq k (1+ k))
        )
        (if (equal k (length pl))
          (setq done t)
        )
      )
      (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
      (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
    )
  )
  (*error* nil)
)
 

Regards, M.R.

ribarm · « **Reply #258 on:** January 06, 2024, 01:43:17 PM »

So, here in attachment is revised version of code I published... But it doesn't finish or just start to some point... Speed is satisfactory, but I would like to see some *.arx, *.brx, *.dll on the same theme...

Regards and stay well in New 2024 Year...

kdub_nz · « **Reply #259 on:** January 06, 2024, 03:55:40 PM »

@ribarm,

What is your definition of

Quote

non-ortho hipped roofs...

Best new year wishes.

ribarm · « **Reply #260 on:** January 06, 2024, 07:09:56 PM »

Quote from: kdub_nz on January 06, 2024, 03:55:40 PM

@ribarm,

What is your definition of
Quote
non-ortho hipped roofs...

Best new year wishes.

The random acute or obtuse angles - without 90 degrees between 2 segments of polygonal closed LWPOLYLINE...

kdub_nz · « **Reply #261 on:** January 06, 2024, 10:04:18 PM »

If I recall correctly from my bin and chute (plate steelwork ) days, for equal angle faces the hip/valley line will always bisect the corner angle,
and logic says that a ridge line will always be central between parallel walls , so I can't imagine a roof will be any different [ except turned upside down ]

But programming for my work discipline is different to yours.

Your definition is as I imagined, but I thought I'd just check terminology

ribarm · « **Reply #262 on:** January 09, 2024, 04:24:23 AM »

Well, no one want to participate... Then how do you expect that need for improvement will happen...
I posted 3 files here : https://www.theswamp.org/index.php?topic=41837.msg618211#msg618211
And no one didn't even download not to mention looked it...
I explained to some point where I need help... It is not that I don't want to write it to the finish... The problem is that variable that holds planes points are removed sooner than should and removal of planes from planes list is the way it should function...
Someone with great expirience should really take look at those 3 attempts (lisps)...

kdub_nz · « **Reply #263 on:** January 09, 2024, 02:23:11 PM »

Marco,
I didn't know you required assistance, I thought your posts were progress reports (ignoring the 'Challenge' in the title

).

Could you re-post one file that works best and the one that you are having issues with ( and describe the issues. )

. . . at least pointing people in the right direction may encourage assistance.

I assume we can select any outline amongst the several posted.

Because I haven't read through the thread;
Does the outline represent the eaves line ?
Where is the roof pitch being set ? (if at all . . I noticed a mention of a plane, so ? )
Do you have any procedural requirements ?

Regards,

ribarm · « **Reply #264 on:** January 09, 2024, 03:15:08 PM »

The last one I coded is "roof-2chk-n.lsp"... But it has lacks that I can't figure why exist... It doesn't complete the job... My thougts were pointed in direction of writing faster version then currently the one that finishes job in slow time period... It is called "roof2d-new-new-new.lsp", but I realized that all we, I needed was faster LISP processing which is acomplished with Bricsys BricsCAD... Anyway there is realy fast one, but it fails in search for finding right combination of variables when starting search... It is called "2droof-final.lsp" and it also completes the job correctly, even better than "roof2d-new-new-new.lsp"... All this you can find in *.ZIP I posted at www.cadtutor.net - download section... So, if someone has spare time, I'd suggest trying to fix "roof-2chk-n.lsp"... There could be perhaps progress in gaining better time execution...

Thanks for interes and Happy Holidays...
M.R.

ribarm · « **Reply #265 on:** January 12, 2024, 01:37:59 PM »

I am realy stacked here with "roof-2chk-n.lsp"... Can someone check it from line 653 - roof-chk-n.lsp / 642 - roof-chk-nn.lsp to the end of file... In my opinion it should work, but it isn't - it just starts and then stops after 6 lines drawn... If someone has spare time, please download it from this post : https://www.theswamp.org/index.php?topic=41837.msg618211#msg618211

Your help is always welcomed...
M.R.

ribarm · « **Reply #266 on:** January 13, 2024, 01:35:10 PM »

As you can see, I've added my latest "roof-2chk-nn.lsp"... So, expecting any feedback... Still it's buggy and sometimes though it starts correctly, may make unexpected mistake(s) - so I've added OVERKILL, just for overlaps, though it may create line(s) that are without any relation to roof solution...

Latest version attached to this post...

pkohut · « **Reply #267 on:** January 14, 2024, 04:55:10 AM »

Quote from: ribarm on January 12, 2024, 01:37:59 PM

I am realy stacked here with "roof-2chk-n.lsp"... Can someone check it from line 653 - roof-chk-n.lsp / 642 - roof-chk-nn.lsp to the end of file... In my opinion it should work, but it isn't - it just starts and then stops after 6 lines drawn... If someone has spare time, please download it from this post : https://www.theswamp.org/index.php?topic=41837.msg618211#msg618211

Your help is always welcomed...
M.R.

Hey Marco,

I added some logging to the code base and collected output, both are in the attached zip file. This should help.

Code: [Select]

;;; printf debugging added by Paul Kohut, 1/14/2024
;;; Purpose: track down why code is not outputting the correct
;;; roof ridge lines. The debug output sent to the acad console,
;;; tags will help tie to the source code/variables/entities.
;;;
;;; The cpatured data was weakly tested against some key subrointes,
;;; all of them preformed as expected.
;;; Original code provided by Marko Ribar in HIPPED ROOF ROUTINES.ZIP

I think this is the problem spot.

Code: [Select]

(setq lst (mapcar (function (lambda ( a b c d ) (list a (angle a b) c d))) pl pli (cons (last tl) (reverse (cdr (reverse tl)))) tl))
        (princ (strcat "\natt=" (itoa att) "  lst length=" (itoa (length lst))))
        (print lst)
;;; pk - I think at this point the first 7 entity are rerun a
;;; few times creating duplicate ridge geometry in lst.
;;; These long complex lines should get reformed so debugging
;;; in VLISP or VS Code is easier.

ribarm · « **Reply #268 on:** January 14, 2024, 11:59:24 AM »

@pkohut

I saw attachment, but reposting the same file I attach doesn't solve things... I posted files in hope that they could be used purpously in task for completion of whole ridge solution on any non-ortho closed polygonal LWPOLYLINE... Nevertheless I attached few more at *.ZIP at cadtutor... So now I wait cos' I don't know why it stops after drawing 6 lines... At the end I'll give up with those roof-*.lsp... So still I am hoping that "roof2d-new-new-new.lsp" could be converted to *.arx, *.brx, or *.dll...

Have a nice day...
M.R.

pkohut · « **Reply #269 on:** January 14, 2024, 02:52:13 PM »

Quote from: ribarm on January 14, 2024, 11:59:24 AM

@pkohut

I saw attachment, but reposting the same file I attach doesn't solve things... I posted files in hope that they could be used purpously in task for completion of whole ridge solution on any non-ortho closed polygonal LWPOLYLINE... Nevertheless I attached few more at *.ZIP at cadtutor... So now I wait cos' I don't know why it stops after drawing 6 lines... At the end I'll give up with those roof-*.lsp... So still I am hoping that "roof2d-new-new-new.lsp" could be converted to *.arx, *.brx, or *.dll...

Have a nice day...
M.R.

So, I spent about 10 hours looking at the code trying to see how it works. Additions were made, to your file, to facilitate collecting data for analysis. That "changed" lisp file is included in my zip attachment. This is just one of the steps I might go through when looking at an unknown problem space. So, the lisp file I attached is not the same as your original.

Given the additional data points, my intent was to look at why the lst variable is not populated properly. Either I'll get lucky figuring it out on my own or maybe someone will chime in with support. Once the program is creating the correct results I can move on to optimizations.

Speaking of optimizations, one of my collected data points was for the entmakex of circle and entdel of said circle, which is called about 750 times. Calling entmake(x) is not very fast and one of the vl- create routines would be much faster. Since the circles are just used for their built in geometry routines, only 2 circles are needed. Create them early, then modify their radius and center points everywhere entmakex is called.

Converting "roof2d-new-new-new.lsp" to ARX can be done by someone familiar with ARX. Someone would have to go routine by routine and do mental gymnastics from Autolisp to ARX. I am not aware of any automated task to do such a conversion. The benefit of such a conversion, faster speed, will be lost because the nested loops run deep recalculating same values over and over. I was going to spend a few cycles doing the conversion to ARX for a straight on head to head comparison. After that I was going to investigate different collection algorithms for huge speed improvements.

I don't think I have anything else useful to contribute.

Later.
That's all I got to say

News:

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

BIGAL

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

ribarm

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

kdub_nz

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

ribarm

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

kdub_nz

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

ribarm

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

kdub_nz

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

ribarm

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

pkohut

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

ribarm

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

pkohut

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