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

0 Members and 1 Guest are viewing this topic.

pkohut

  • Bull Frog
  • Posts: 474
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #210 on: February 27, 2023, 07:41:01 AM »


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

Where are the code comments?
Want speed - get out of lisp.
Want speed - keep nested loops to a minimum.
Want speed - don't do heavy calculations deep in the loops.
Want speed - don't do if checks deep in the loops.
Want speed - learn algorithms and data structures.

New tread (not retired) - public repo at https://github.com/pkohut

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #211 on: February 27, 2023, 07:58:43 AM »


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

Where are the code comments?
Want speed - get out of lisp.
Want speed - keep nested loops to a minimum.
Want speed - don't do heavy calculations deep in the loops.
Want speed - don't do if checks deep in the loops.
Want speed - learn algorithms and data structures.



Why do you need code comments?
For other opinions I agree, but not my field of knowledge...
It could be written in lisp for sure to be fast enough - look at chlh_jd's example...
The problem is that complexity may grow - ultimate roofs - 100 and more vertices...

If you test it, you'll see what it do till now... The problem arises with widening code - finding correct solution based on offsetting...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #212 on: February 28, 2023, 01:19:58 PM »
And here is it classical example of how topic get overcrowded with other new ones...

Have someone thought ab this examples, especially the ones posted at cadtutor.net - download section...

I would like to see something new that may be better than my attempts...

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

:)

M.R. on Youtube

pkohut

  • Bull Frog
  • Posts: 474
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #213 on: February 28, 2023, 02:48:52 PM »
And here is it classical example of how topic get overcrowded with other new ones...

Have someone thought ab this examples, especially the ones posted at cadtutor.net - download section...

I would like to see something new that may be better than my attempts...

M.R.

Fair enough.  Your playground, your rules.  Take my non-lisp ball to another field.   :2funny:
New tread (not retired) - public repo at https://github.com/pkohut

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #214 on: March 01, 2023, 10:18:03 AM »
 :-D :knuppel2:
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #215 on: March 06, 2023, 10:53:05 AM »
To all users, or else watching...

Can this routine here in attachment work faster with ultimate roof example, and not to depend on PC hardware architecture configuration...

I am not searching translation to ARX, BRX, (but I suppose it would be perfect) or something else, though and DLL for latest versions of Auto/BricsCAD would be very welcomed, I also need tweaks if someone operates with *.LSP on higher level of intelligence...

Link for ultimate roof DWG : https://www.theswamp.org/index.php?topic=41837.msg613477#msg613477
« Last Edit: March 10, 2023, 02:45:15 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #216 on: March 06, 2023, 12:11:08 PM »
Letter to programmer masters...
Quote
Is my routine hardware dependent... (roof2d-new-new-offset.lsp)... If so, which is mostly the case, then the job is done... I don't know how to tweak for ultimate roofs (100 and more vertices)... If it doesn't depend on the hardware, then let someone more expert than me take a look... It doesn't matter if it's *.lsp, *.arx, *.brx, * .dll... it's only important that it works optimally, which I doubt... I don't know, if you care, ask around, maybe by chance a solution for slowness will be found... I took all the parameters into circulation and matched them with each other ... Perhaps I should have left something out, but then not all the tests would have passed... See what you can do, if you have the time and interest...

Testing *.DWG is in attachment...
« Last Edit: March 10, 2023, 01:57:40 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #217 on: March 07, 2023, 10:35:30 AM »
 :-( :-( :-(
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #218 on: March 11, 2023, 11:56:24 AM »
I've found some workaround... It was all the time in front of my(ours) nose...
As for the ultimate roofs, test for 1 full rotation of vertices, so if it is not found the first time, trim one of the sides of the lwpoly, turn it closed through palette, which changes the initial vertex... After a bit of hacking in this way, 2droof-final.lsp should find solution within 1 to 2 seconds... Just don't forget that errm doesn't even need to iterate... The solution should be solvable during the first iteration of errn...

New update is here : https://www.cadtutor.net/forum/files/file/36-hipped-roof-routines/
« Last Edit: March 20, 2023, 12:15:27 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #219 on: July 20, 2023, 02:02:40 PM »
I had some spare time, so I've coded for smaller more concise version... But how story goes, what is short and quick it's more lackable... Still if someone want's to connect and improve, here is it...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:roof-new ( / *error* unit rlw offd inside-p collinear-p unique chkcircinside mc subprocess1 subprocess2 subprocess process done lw lwi lwx lwo ent enti lil lix lwnl ch el p1 p2 pp ppp ipp ippl vll vlli tll iplst iplstt iplsttt lst lstt ) ;;; cad, doc, spc, lay, vlll, vllli, tlll, tmp, f - global variables ;;;
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (if (and lwi (not (vlax-erased-p lwi)))
  6.       (entdel lwi)
  7.     )
  8.     (if (and enti (not (vlax-erased-p enti)))
  9.       (entdel enti)
  10.     )
  11.     (if (setq ppp (unique ppp))
  12.       (foreach pp ppp
  13.         (if (not (vl-some '(lambda ( x ) (and (not (equal (car x) pp 1e-6)) (not (equal (cadr x) pp 1e-6)) (not (equal (car x) (cadr x) 1e-6)) (collinear-p (car x) pp (cadr x)))) lil))
  14.           (entmake (list (cons 0 "POINT") (cons 10 pp) (cons 62 1)))
  15.         )
  16.       )
  17.     )
  18.     (if (= ch "No")
  19.       (while (setq el (entnext el))
  20.         (if (and el (not (vlax-erased-p el)))
  21.           (entdel el)
  22.         )
  23.       )
  24.     )
  25.     (if lil
  26.       (foreach li lil
  27.         (if (vl-some '(lambda ( x ) (and (not (equal (car li) x 1e-6)) (not (equal (cadr li) x 1e-6)) (not (equal (car li) (cadr li) 1e-6)) (collinear-p (car li) x (cadr li)))) ppp)
  28.           (setq lil (vl-remove li lil))
  29.           (if (vl-some '(lambda ( x ) (equal x (car li) 1e-6)) ppp)
  30.             (entmake (list (cons 0 "LINE") (cons 10 (car li)) (cons 11 (cadr li)) (cons 62 3)))
  31.           )
  32.         )
  33.       )
  34.     )
  35.     (command-s "_.-OVERKILL" "_ALL" "_T" "_Y" "" "")
  36.     (if (= 8 (logand 8 (getvar 'undoctl)))
  37.       (vla-endundomark doc)
  38.     )
  39.     (prompt "\nIf you want to start again on different sample, make sure you nil flag f : (setq f nil vlll nil vllli nil tlll nil tmp nil) ...")
  40.     (if m
  41.       (prompt m)
  42.     )
  43.     (princ)
  44.   )
  45.  
  46.   (defun unit ( v / d )
  47.     (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-6))
  48.       (mapcar '(lambda ( x ) (/ x d)) v)
  49.     )
  50.   )
  51.  
  52.   (defun rlw ( lw / e x1 x2 x3 x4 x5 x6 )
  53.     ;; by ElpanovEvgeniy
  54.     (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
  55.       (progn
  56.         (foreach a1 e
  57.           (cond ((= (car a1) 10) (setq x2 (cons a1 x2)))
  58.                 ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)))
  59.                 ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)))
  60.                 ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)))
  61.                 ((= (car a1) 210) (setq x6 (cons a1 x6)))
  62.                 (t (setq x1 (cons a1 x1)))
  63.           )
  64.         )
  65.         (entmod (append (reverse x1)
  66.                   (append (apply 'append
  67.                             (apply 'mapcar
  68.                               (cons 'list
  69.                                 (list x2
  70.                                   (cdr (reverse (cons (car x3) (reverse x3))))
  71.                                   (cdr (reverse (cons (car x4) (reverse x4))))
  72.                                   (cdr (reverse (cons (car x5) (reverse x5))))
  73.                                 )
  74.                               )
  75.                             )
  76.                           )
  77.                           x6
  78.                   )
  79.                 )
  80.         )
  81.         (entupd lw)
  82.       )
  83.     )
  84.   )
  85.  
  86.   (defun offd ( sign ip tl / dl )
  87.     (setq dl (mapcar '(lambda ( x )
  88.                         (distance ip
  89.                           (inters
  90.                             ip
  91.                             (polar ip (+ (* 0.5 pi) (angle (car x) (cadr x))) 1.0)
  92.                             (car x)
  93.                             (polar (car x) (angle (car x) (cadr x)) 1.0)
  94.                             nil
  95.                           )
  96.                         )
  97.                       ) tl
  98.               )
  99.     )
  100.     (vl-some '(lambda ( x )
  101.                (if
  102.                  (>
  103.                    (-
  104.                      (length dl)
  105.                      (length (vl-remove-if '(lambda ( y ) (equal x y 1.0)) dl))
  106.                    ) 2
  107.                  )
  108.                  x
  109.                )
  110.              ) (vl-sort dl sign)
  111.     )
  112.   )
  113.  
  114.   (defun inside-p ( p lw lwi )
  115.   )
  116.  
  117.   (defun collinear-p ( p1 p p2 )
  118.     (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  119.   )
  120.  
  121.   (defun unique ( pl )
  122.     (if pl
  123.       (cons (car pl)
  124.             (unique
  125.               (vl-remove-if
  126.                 '(lambda ( x )
  127.                    (equal x (car pl) 1e-6)
  128.                  )
  129.                 (cdr pl)
  130.               )
  131.             )
  132.       )
  133.     )
  134.   )
  135.  
  136.   (defun chkcircinside ( pp tll / d ci ipp ippl tst )
  137.     (if (and pp tll)
  138.       (progn
  139.         (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 pp) (cons 40 (offd (function <) pp tll)))))
  140.         (if (setq ipp (vlax-invoke (vlax-ename->vla-object ci) 'intersectwith (vlax-ename->vla-object ent) acextendnone))
  141.           (progn
  142.             (while ipp
  143.               (setq ippl (cons (list (car ipp) (cadr ipp) (caddr ipp)) ippl))
  144.               (setq ipp (cdddr ipp))
  145.             )
  146.             (if (or (not ippl) (vl-every '(lambda ( x ) (inside-p x ent enti)) (apply 'append (mapcar '(lambda ( x ) (list (vlax-curve-getpointatparam ci (- x 0.1)) (vlax-curve-getpointatparam ci (+ x 0.1)))) (mapcar '(lambda ( x ) (vlax-curve-getparamatpoint ci x)) ippl)))))
  147.               (setq tst t)
  148.             )
  149.           )
  150.           (setq tst t)
  151.         )
  152.         (if (and ci (not (vlax-erased-p ci)))
  153.           (entdel ci)
  154.         )
  155.       )
  156.     )
  157.     tst
  158.   )
  159.  
  160.   (defun mc ( p lw / ci pl mp )
  161.     (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 1.0))))
  162.     (setq pl (vlax-invoke (vlax-ename->vla-object ci) 'intersectwith (vlax-ename->vla-object lw) acextendnone))
  163.     (if (and ci (not (vlax-erased-p ci)))
  164.       (entdel ci)
  165.     )
  166.     (setq mp (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (list (car pl) (cadr pl)) (list (nth 3 pl) (nth 4 pl))))
  167.     (list p mp)
  168.   )
  169.  
  170.   (defun subprocess1 ( vl vli / ip ) ;;; iplst - lexical global variable
  171.     (setq iplst (mapcar '(lambda ( p1 p2 p3 p4 / ip )
  172.                           (if
  173.                             (and
  174.                               (setq ip (inters p1 p2 p3 p4 nil))
  175.                               (inside-p ip ent enti)
  176.                               (equal (unit (mapcar '- ip p1)) (unit (mapcar '- p2 p1)) 1e-6)
  177.                               (equal (unit (mapcar '- ip p3)) (unit (mapcar '- p4 p3)) 1e-6)
  178.                               (inside-p (mapcar '+ p1 (mapcar '* (unit (mapcar '- ip p1)) (list 1e-2 1e-2))) ent enti)
  179.                               (inside-p (mapcar '+ p3 (mapcar '* (unit (mapcar '- ip p3)) (list 1e-2 1e-2))) ent enti)
  180.                             )
  181.                             (list ip (list p1 p3))
  182.                             (list nil nil)
  183.                           )
  184.                         )
  185.                         vl
  186.                         vli
  187.                         (append (cdr vl) (list (car vl)))
  188.                         (append (cdr vli) (list (car vli)))
  189.                 )
  190.     )
  191.   )
  192.  
  193.   (defun subprocess2 ( p lw vl vli / ip lst lstt ) ;;; iplst - lexical global variable
  194.     (setq iplst (mapcar '(lambda ( p1 p2 p3 p4 / ip )
  195.                           (if
  196.                             (and
  197.                               (setq ip (inters p1 p2 p3 p4 nil))
  198.                               (inside-p ip ent enti)
  199.                               (equal (unit (mapcar '- ip p1)) (unit (mapcar '- p2 p1)) 1e-6)
  200.                               (equal (unit (mapcar '- ip p3)) (unit (mapcar '- p4 p3)) 1e-6)
  201.                               (inside-p (mapcar '+ p1 (mapcar '* (unit (mapcar '- ip p1)) (list 1e-2 1e-2))) ent enti)
  202.                               (inside-p (mapcar '+ p3 (mapcar '* (unit (mapcar '- ip p3)) (list 1e-2 1e-2))) ent enti)
  203.                             )
  204.                             (list ip (list p1 p3))
  205.                             (list nil nil)
  206.                           )
  207.                         )
  208.                         vl
  209.                         vli
  210.                         (repeat (length vl) (setq lst (cons (car (mc p lw)) lst)))
  211.                         (repeat (length vl) (setq lstt (cons (cadr (mc p lw)) lstt)))
  212.                 )
  213.     )
  214.   )
  215.  
  216.   (defun subprocess ( iplst / p1 p2 pp1 pp2 k i dd )
  217.     (setq iplst (vl-remove-if '(lambda ( x ) (or (null (car x)) (null (cadr x)))) iplst))
  218.     (setq iplstoffd (mapcar '(lambda ( x ) (if (and (car x) (cadr x))
  219.                                              (list
  220.                                                (mapcar '+ '(0.0 0.0) (car x))
  221.                                                (mapcar '(lambda ( y ) (mapcar '+ '(0.0 0.0) y)) (cadr x))
  222.                                                (offd (function <) (mapcar '+ '(0.0 0.0) (car x)) tlll)
  223.                                              )
  224.                                              (list nil nil nil)
  225.                                            )
  226.                              ) iplst
  227.                     )
  228.     )
  229.     (setq iplstoffd (vl-remove-if '(lambda ( x ) (null (caddr x))) iplstoffd))
  230.     (setq iplstoffd (vl-sort iplstoffd '(lambda ( a b ) (< (caddr a) (caddr b)))))
  231.     (foreach ipd iplstoffd
  232.       (if (not tmp)
  233.         (setq tmp (offd (function <) (car ipd) tlll))
  234.       )
  235.       (if (and ipd (chkcircinside (car ipd) tlll) (<= tmp (setq tmp (offd (function <) (car ipd) tlll))))
  236.         (progn
  237.           (setq ppp (cons (car ipd) ppp))
  238.           (if
  239.             (and
  240.               (setq p1
  241.                 (vl-some '(lambda ( x )
  242.                   (if
  243.                     (equal
  244.                       (unit (mapcar '- (car ipd) x))
  245.                       (unit (mapcar '- (car ipd) (caadr ipd)))
  246.                       1e-6
  247.                     )
  248.                     x
  249.                   )
  250.                 ) vll
  251.                 )
  252.               )
  253.               (setq pp1
  254.                 (vl-some '(lambda ( x )
  255.                   (if
  256.                     (equal
  257.                       (unit (mapcar '- (car ipd) x))
  258.                       (unit (mapcar '- (car ipd) p1))
  259.                       1e-6
  260.                     )
  261.                     x
  262.                   )
  263.                 ) vlll
  264.                 )
  265.               )
  266.             )
  267.             (setq lil (cons (list (car ipd) pp1) lil))
  268.             (if p1
  269.               (setq lil (cons (list (car ipd) p1) lil))
  270.               (setq lil (cons (list (car ipd) (caadr ipd)) lil))
  271.             )
  272.           )
  273.           (if
  274.             (and
  275.               (setq p2
  276.                 (vl-some '(lambda ( x )
  277.                   (if
  278.                     (equal
  279.                       (unit (mapcar '- (car ipd) x))
  280.                       (unit (mapcar '- (car ipd) (cadadr ipd)))
  281.                       1e-6
  282.                     )
  283.                     x
  284.                   )
  285.                 ) vll
  286.                 )
  287.               )
  288.               (setq pp2
  289.                 (vl-some '(lambda ( x )
  290.                   (if
  291.                     (equal
  292.                       (unit (mapcar '- (car ipd) x))
  293.                       (unit (mapcar '- (car ipd) p2))
  294.                       1e-6
  295.                     )
  296.                     x
  297.                   )
  298.                 ) vlll
  299.                 )
  300.               )
  301.             )
  302.             (setq lil (cons (list (car ipd) pp2) lil))
  303.             (if p2
  304.               (setq lil (cons (list (car ipd) p2) lil))
  305.               (setq lil (cons (list (car ipd) (cadadr ipd)) lil))
  306.             )
  307.           )
  308.           (setq k 1e-4 i 0)
  309.           (while
  310.             (and
  311.               (caddr ipd)
  312.               (setq dd (- (caddr ipd) (* k (setq i (1+ i)))))
  313.               (setq lwnl (vl-catch-all-apply
  314.                 'vlax-invoke
  315.                 (list (vlax-ename->vla-object lw) 'offset (- dd))
  316.               ))
  317.               (if (vl-catch-all-error-p lwnl)
  318.                 (/= i 10)
  319.               )
  320.             )
  321.           )
  322.           (if (not (vl-catch-all-error-p lwnl))
  323.             (setq lwnl (mapcar 'vlax-vla-object->ename lwnl))
  324.             lwnl
  325.           )
  326.           (if (and (not (vl-catch-all-error-p lwnl)) (= (length lwnl) 1))
  327.             (setq iplstt (cons (list (car ipd) (car lwnl)) iplstt))
  328.           )
  329.         )
  330.       )
  331.     )
  332.     (setq tmp nil)
  333.     lwnl
  334.   )
  335.  
  336.   (defun process ( lw / lwi lwx vl vli iplst tl ipd iplstoffd p1 p2 pp lwnl ) ;;; vll ; vlli ; tll ; lwnl ; ppp ; iplstt - lexical global variables ;;;
  337.     (if lw
  338.       (progn
  339.         (setq vl (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (setq lwx (entget lw)))))
  340.         (if (not vll)
  341.           (setq vll vl)
  342.         )
  343.         (setq lwi (vlax-vla-object->ename (car (vlax-invoke (vlax-ename->vla-object lw) 'offset -1e-3))))
  344.         (setq vli (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget lwi))))
  345.         (if (not vlli)
  346.           (setq vlli vli)
  347.         )
  348.         (setq tl (mapcar '(lambda ( a b ) (list a b)) vl (append (cdr vl) (list (car vl)))))
  349.         (if (not tll)
  350.           (setq tll tl)
  351.         )
  352.         (setq iplst (subprocess1 vl vli))
  353.         (subprocess iplst)
  354.         (setq iplst nil)
  355.         (foreach pp iplstt
  356.           (setq iplsttt (append iplsttt (subprocess2 (car pp) (cadr pp) vl vli)))
  357.         )
  358.         (subprocess iplsttt)
  359.         (if (and lwi (not (vlax-erased-p lwi)))
  360.           (entdel lwi)
  361.         )
  362.         lwnl
  363.       )
  364.     )
  365.   )
  366.  
  367.   (or doc (setq doc (vla-get-activedocument cad)))
  368.   (or spc (setq spc (vla-get-block (setq lay (vla-get-activelayout doc)))))
  369.  
  370.   (if (= 8 (logand 8 (getvar 'undoctl)))
  371.     (vla-endundomark doc)
  372.   )
  373.   (if
  374.     (and
  375.       (setq lw (car (entsel "\nPick boundary closed polygonal LWPOLYLINE with only straight segments...")))
  376.       (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE")
  377.       (= 1 (logand 1 (cdr (assoc 70 lwx))))
  378.       (vl-every '(lambda ( x ) (= 0.0 (cdr x))) (vl-remove-if '(lambda ( x ) (/= (car x) 42)) lwx))
  379.       (setq el (entlast) ent lw)
  380.     )
  381.     (progn
  382.       (setq lwi (vlax-vla-object->ename (car (vlax-invoke (vlax-ename->vla-object lw) 'offset -1e-3))))
  383.       (if (> (vlax-curve-getarea lwi) (vlax-curve-getarea lw))
  384.         (setq lw (rlw lw)) ;;; force main lwpolyline CCW - counter clockwise ;;;
  385.       )
  386.       (setq enti (vlax-vla-object->ename (car (vlax-invoke (vlax-ename->vla-object ent) 'offset -1e-3))))
  387.       (if (and lwi (not (vlax-erased-p lwi)))
  388.         (entdel lwi)
  389.       )
  390.       (if (not f)
  391.         (progn
  392.           (setq vlll (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget ent))))
  393.           (setq vllli (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget enti))))
  394.           (setq tlll (mapcar '(lambda ( a b ) (list a b)) vlll (append (cdr vlll) (list (car vlll)))))
  395.           (setq f t)
  396.         )
  397.       )
  398.       (initget "Yes No")
  399.       (setq ch (cond ((getkword "\nDo you want points-offsets-lines or just lines [Yes / No] <Yes> - there are some lacks with just lines, so HIT ENTER : ")) ( "Yes" )))
  400.       (while (not done)
  401.         (if
  402.           (and
  403.             (not (vl-catch-all-error-p (setq lwnl (vl-catch-all-apply 'process (list lw)))))
  404.             lwnl
  405.           )
  406.           (while (and (not done) (setq lww (car lwnl)))
  407.             (setq lwnl (vl-remove lww lwnl))
  408.             (setq lwo lww)
  409.             (setq lwnl (vl-catch-all-apply 'process (list lww)))
  410.             (if (vl-catch-all-error-p lwnl)
  411.               (setq done t)
  412.               (if (eq (car lwnl) lwo)
  413.                 (setq done t)
  414.               )
  415.             )
  416.           )
  417.           (setq done t)
  418.         )
  419.       ) ;;; main engine ;;;
  420.     )
  421.   )
  422.   (*error* nil)
  423. )
  424.  

Regards, M.R.
« Last Edit: August 07, 2023, 08:30:30 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #220 on: July 21, 2023, 11:26:03 AM »
The lack that I see now and before is that that's built-in offset command... When I offset inside through point for example drawn inside point "P", offset LWPOLYLINE may pass and may not pass through and in that case usually it breaks to a few more smaller LWPOLYLINES...
So now problem consist in solving this task, upon solving and applying in my lastly posted code, solution should be successfuly created...

Any ideas are very welcomed...
Thanks for reading, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #221 on: July 21, 2023, 12:41:49 PM »
I've created sub (offset-inside), but it doesn't help, especially as I don't quite know how to combine it with real offset command function...

Code: [Select]
THE CODE IS SOMEWHAT WORSE THAN PREVIOUSLY POSTED, SO I REMOVED IT FROM SITE...

So, who want's to find solution in his own manner is welcomed to step in...
M.R.
« Last Edit: July 23, 2023, 02:58:13 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #222 on: August 03, 2023, 02:04:42 PM »
I just wanted to put this topic back at top of list so it remains as not solved challenge... It should work fast and follow offset inside paths...
My latest version is example of short and efficient code, but it just gives partial ridge lines... Like I said, someone with more experiences should step in and try to correct it...
So long from me...
See you these days if you have something...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #223 on: August 07, 2023, 02:32:23 PM »
I don't see any feedback...
What should I change in posted code... (C:ROOF-NEW)

Thanks for your advices if there are any newly ones...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3132
  • Marko Ribar, architect
Re: ==={Challenge}===Find the ridge lines of sloped roof
« Reply #224 on: August 08, 2023, 01:30:57 AM »
I've changed a bit, so now it looks better, but it goes in infinite loops and doesn't do what I predicted - from smallest offset then first just a little larger offset where points are met, and so on, so on... It seems that this topic is not so interesting, but now I feel that I am close to finish correct... It's just that PC doesn't want to operate as expected...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:roof-new-new ( / *error* unit rlw offd inside-p collinear-p unique chkcircinside mc preprocess1 preprocess2 rem-vllvlli subprocess process done lw lwi lwx lwo ent enti lil lix lwnl ch el p1 p2 pp ppp ipp ippl vll vlli tll iplst lst ) ;;; cad, doc, spc, lay, vlll, vllli, tlll, f - global variables ;;;
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (if (and lwi (not (vlax-erased-p lwi)))
  6.       (entdel lwi)
  7.     )
  8.     (if (and enti (not (vlax-erased-p enti)))
  9.       (entdel enti)
  10.     )
  11.     (if (setq ppp (unique ppp))
  12.       (foreach pp ppp
  13.         (if (not (vl-some '(lambda ( x ) (and (not (equal (car x) pp 1e-6)) (not (equal (cadr x) pp 1e-6)) (not (equal (car x) (cadr x) 1e-6)) (collinear-p (car x) pp (cadr x)))) lil))
  14.           (entmake (list (cons 0 "POINT") (cons 10 pp) (cons 62 1)))
  15.         )
  16.       )
  17.     )
  18.     (if (= ch "No")
  19.       (while (setq el (entnext el))
  20.         (if (and el (not (vlax-erased-p el)))
  21.           (entdel el)
  22.         )
  23.       )
  24.     )
  25.     (if lil
  26.       (foreach li lil
  27.         (if (vl-some '(lambda ( x ) (and (not (equal (car li) x 1e-6)) (not (equal (cadr li) x 1e-6)) (not (equal (car li) (cadr li) 1e-6)) (collinear-p (car li) x (cadr li)))) ppp)
  28.           (setq lil (vl-remove li lil))
  29.           (if (vl-some '(lambda ( x ) (equal x (car li) 1e-6)) ppp)
  30.             (entmake (list (cons 0 "LINE") (cons 10 (car li)) (cons 11 (cadr li)) (cons 62 3)))
  31.           )
  32.         )
  33.       )
  34.     )
  35.     (command-s "_.-OVERKILL" "_ALL" "_T" "_Y" "" "")
  36.     (if (= 8 (logand 8 (getvar 'undoctl)))
  37.       (vla-endundomark doc)
  38.     )
  39.     (prompt "\nIf you want to start again on different sample, make sure you nil flag f : (setq f nil vlll nil vllli nil tlll nil) ...")
  40.     (if m
  41.       (prompt m)
  42.     )
  43.     (princ)
  44.   )
  45.  
  46.   (defun unit ( v / d )
  47.     (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-6))
  48.       (mapcar '(lambda ( x ) (/ x d)) v)
  49.     )
  50.   )
  51.  
  52.   (defun rlw ( lw / e x1 x2 x3 x4 x5 x6 )
  53.     ;; by ElpanovEvgeniy
  54.     (if (= (cdr (assoc 0 (setq e (entget lw)))) "LWPOLYLINE")
  55.       (progn
  56.         (foreach a1 e
  57.           (cond ((= (car a1) 10) (setq x2 (cons a1 x2)))
  58.                 ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4)))
  59.                 ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3)))
  60.                 ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5)))
  61.                 ((= (car a1) 210) (setq x6 (cons a1 x6)))
  62.                 (t (setq x1 (cons a1 x1)))
  63.           )
  64.         )
  65.         (entmod (append (reverse x1)
  66.                   (append (apply 'append
  67.                             (apply 'mapcar
  68.                               (cons 'list
  69.                                 (list x2
  70.                                   (cdr (reverse (cons (car x3) (reverse x3))))
  71.                                   (cdr (reverse (cons (car x4) (reverse x4))))
  72.                                   (cdr (reverse (cons (car x5) (reverse x5))))
  73.                                 )
  74.                               )
  75.                             )
  76.                           )
  77.                           x6
  78.                   )
  79.                 )
  80.         )
  81.         (entupd lw)
  82.       )
  83.     )
  84.   )
  85.  
  86.   (defun offd ( sign ip tl / dl )
  87.     (setq dl (mapcar '(lambda ( x )
  88.                         (distance ip
  89.                           (inters
  90.                             ip
  91.                             (polar ip (+ (* 0.5 pi) (angle (car x) (cadr x))) 1.0)
  92.                             (car x)
  93.                             (polar (car x) (angle (car x) (cadr x)) 1.0)
  94.                             nil
  95.                           )
  96.                         )
  97.                       ) tl
  98.               )
  99.     )
  100.     (vl-some '(lambda ( x )
  101.                (if
  102.                  (>
  103.                    (-
  104.                      (length dl)
  105.                      (length (vl-remove-if '(lambda ( y ) (equal x y 0.05)) dl))
  106.                    ) 2
  107.                  )
  108.                  x
  109.                )
  110.              ) (vl-sort dl sign)
  111.     )
  112.   )
  113.  
  114.   (defun inside-p ( p lw lwi )
  115.   )
  116.  
  117.   (defun collinear-p ( p1 p p2 )
  118.     (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  119.   )
  120.  
  121.   (defun unique ( pl )
  122.     (if pl
  123.       (cons (car pl)
  124.             (unique
  125.               (vl-remove-if
  126.                 '(lambda ( x )
  127.                    (equal x (car pl) 1e-6)
  128.                  )
  129.                 (cdr pl)
  130.               )
  131.             )
  132.       )
  133.     )
  134.   )
  135.  
  136.   (defun chkcircinside ( pp tll / d ci ipp ippl tst )
  137.     (if (and pp tll)
  138.       (progn
  139.         (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 pp) (cons 40 (offd (function <) pp tll)))))
  140.         (if (setq ipp (vlax-invoke (vlax-ename->vla-object ci) 'intersectwith (vlax-ename->vla-object ent) acextendnone))
  141.           (progn
  142.             (while ipp
  143.               (setq ippl (cons (list (car ipp) (cadr ipp) (caddr ipp)) ippl))
  144.               (setq ipp (cdddr ipp))
  145.             )
  146.             (if (or (not ippl) (vl-every '(lambda ( x ) (inside-p x ent enti)) (apply 'append (mapcar '(lambda ( x ) (list (vlax-curve-getpointatparam ci (- x 0.1)) (vlax-curve-getpointatparam ci (+ x 0.1)))) (mapcar '(lambda ( x ) (vlax-curve-getparamatpoint ci x)) ippl)))))
  147.               (setq tst t)
  148.             )
  149.           )
  150.           (setq tst t)
  151.         )
  152.         (if (and ci (not (vlax-erased-p ci)))
  153.           (entdel ci)
  154.         )
  155.       )
  156.     )
  157.     tst
  158.   )
  159.  
  160.   (defun mc ( p lw / ci pl mp )
  161.     (setq ci (entmakex (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 1.0))))
  162.     (setq pl (vlax-invoke (vlax-ename->vla-object ci) 'intersectwith (vlax-ename->vla-object lw) acextendnone))
  163.     (if (and ci (not (vlax-erased-p ci)))
  164.       (entdel ci)
  165.     )
  166.     (setq mp (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (list (car pl) (cadr pl)) (list (nth 3 pl) (nth 4 pl))))
  167.     (list p mp)
  168.   )
  169.  
  170.   (defun preprocess1 ( vl vli / ip ) ;;; iplst - lexical global variable
  171.     (setq iplst (mapcar '(lambda ( p1 p2 p3 p4 / ip )
  172.                           (if
  173.                             (and
  174.                               (setq ip (inters p1 p2 p3 p4 nil))
  175.                               (inside-p ip ent enti)
  176.                               (equal (unit (mapcar '- ip p1)) (unit (mapcar '- p2 p1)) 1e-6)
  177.                               (equal (unit (mapcar '- ip p3)) (unit (mapcar '- p4 p3)) 1e-6)
  178.                               (inside-p (mapcar '+ p1 (mapcar '* (unit (mapcar '- ip p1)) (list 1e-2 1e-2))) ent enti)
  179.                               (inside-p (mapcar '+ p3 (mapcar '* (unit (mapcar '- ip p3)) (list 1e-2 1e-2))) ent enti)
  180.                             )
  181.                             (list ip (list p1 p3))
  182.                             (list nil nil)
  183.                           )
  184.                         )
  185.                         vl
  186.                         vli
  187.                         (append (cdr vl) (list (car vl)))
  188.                         (append (cdr vli) (list (car vli)))
  189.                 )
  190.     )
  191.     iplst
  192.   )
  193.  
  194.   (defun preprocess2 ( vl vli / ip ) ;;; iplst - lexical global variable
  195.     (setq iplst (mapcar '(lambda ( p1 p2 p3 p4 / ip )
  196.                           (if
  197.                             (and
  198.                               (setq ip (inters p1 p2 p3 p4 nil))
  199.                               (inside-p ip ent enti)
  200.                               (equal (unit (mapcar '- ip p1)) (unit (mapcar '- p2 p1)) 1e-6)
  201.                               (equal (unit (mapcar '- ip p3)) (unit (mapcar '- p4 p3)) 1e-6)
  202.                               (inside-p (mapcar '+ p1 (mapcar '* (unit (mapcar '- ip p1)) (list 1e-2 1e-2))) ent enti)
  203.                               (inside-p (mapcar '+ p3 (mapcar '* (unit (mapcar '- ip p3)) (list 1e-2 1e-2))) ent enti)
  204.                             )
  205.                             (list ip (list p1 p3))
  206.                             (list nil nil)
  207.                           )
  208.                         )
  209.                         vl
  210.                         vli
  211.                         (mapcar '(lambda ( x ) (car (mc (caar lil) (car lwnl)))) vl)
  212.                         (mapcar '(lambda ( x ) (cadr (mc (caar lil) (car lwnl)))) vli)
  213.                 )
  214.     )
  215.     iplst
  216.   )
  217.  
  218.   (defun rem-vllvlli ( lil lwnl )
  219.     (if (vl-some '(lambda ( x ) (equal x (cadr (car lil)) 1e-2)) vll)
  220.       (progn
  221.         (setq vll (vl-remove-if '(lambda ( x ) (equal (cadr (car lil)) x 1e-2)) vll))
  222.         (setq vlli (vl-remove-if '(lambda ( x ) (equal (cadr (car lil)) x 1e-2)) vlli))
  223.       )
  224.     )
  225.     (if (vl-some '(lambda ( x ) (equal x (cadr (cadr lil)) 1e-2)) vll)
  226.       (progn
  227.         (setq vll (vl-remove-if '(lambda ( x ) (equal (cadr (cadr lil)) x 1e-2)) vll))
  228.         (setq vlli (vl-remove-if '(lambda ( x ) (equal (cadr (cadr lil)) x 1e-2)) vlli))
  229.       )
  230.     )
  231.   )
  232.  
  233.   (defun subprocess ( iplst / p1 p2 pp1 pp2 )
  234.     (setq iplst (vl-remove-if '(lambda ( x ) (or (null (car x)) (null (cadr x)))) iplst))
  235.     (setq iplstoffd (mapcar '(lambda ( x ) (if (and (car x) (cadr x))
  236.                                              (list
  237.                                                (mapcar '+ '(0.0 0.0) (car x))
  238.                                                (mapcar '(lambda ( y ) (mapcar '+ '(0.0 0.0) y)) (cadr x))
  239.                                                (offd (function <) (mapcar '+ '(0.0 0.0) (car x)) tlll)
  240.                                              )
  241.                                              (list nil nil nil)
  242.                                            )
  243.                              ) iplst
  244.                     )
  245.     )
  246.     (setq iplstoffd (vl-remove-if '(lambda ( x ) (null (caddr x))) iplstoffd))
  247.     (setq iplstoffd (vl-sort iplstoffd '(lambda ( a b ) (< (caddr a) (caddr b)))))
  248.     (if (not (vl-position (car iplstoffd) lst))
  249.       (setq ipd (car iplstoffd) lst (cons ipd lst))
  250.       (progn
  251.         (setq iplstoffd (cdr (member (car lst) iplstoffd)))
  252.         (setq ipd (car iplstoffd) lst (cons ipd lst))
  253.       )
  254.     )
  255.     (if (and ipd (chkcircinside (car ipd) tlll))
  256.       (progn
  257.         (setq ppp (cons (car ipd) ppp))
  258.         (if
  259.           (and
  260.             (setq p1
  261.               (vl-some '(lambda ( x )
  262.                 (if
  263.                   (equal
  264.                     (unit (mapcar '- (car ipd) x))
  265.                     (unit (mapcar '- (car ipd) (caadr ipd)))
  266.                     1e-6
  267.                   )
  268.                   x
  269.                 )
  270.               ) vll
  271.               )
  272.             )
  273.             (setq pp1
  274.               (vl-some '(lambda ( x )
  275.                 (if
  276.                   (equal
  277.                     (unit (mapcar '- (car ipd) x))
  278.                     (unit (mapcar '- (car ipd) p1))
  279.                     1e-6
  280.                   )
  281.                   x
  282.                 )
  283.               ) vlll
  284.               )
  285.             )
  286.           )
  287.           (setq lil (cons (list (car ipd) pp1) lil))
  288.           (if p1
  289.             (setq lil (cons (list (car ipd) p1) lil))
  290.             (setq lil (cons (list (car ipd) (caadr ipd)) lil))
  291.           )
  292.         )
  293.         (if
  294.           (and
  295.             (setq p2
  296.               (vl-some '(lambda ( x )
  297.                 (if
  298.                   (equal
  299.                     (unit (mapcar '- (car ipd) x))
  300.                     (unit (mapcar '- (car ipd) (cadadr ipd)))
  301.                     1e-6
  302.                   )
  303.                   x
  304.                 )
  305.               ) vll
  306.               )
  307.             )
  308.             (setq pp2
  309.               (vl-some '(lambda ( x )
  310.                 (if
  311.                   (equal
  312.                     (unit (mapcar '- (car ipd) x))
  313.                     (unit (mapcar '- (car ipd) p2))
  314.                     1e-6
  315.                   )
  316.                   x
  317.                 )
  318.               ) vlll
  319.               )
  320.             )
  321.           )
  322.           (setq lil (cons (list (car ipd) pp2) lil))
  323.           (if p2
  324.             (setq lil (cons (list (car ipd) p2) lil))
  325.             (setq lil (cons (list (car ipd) (cadadr ipd)) lil))
  326.           )
  327.         )
  328.         (if
  329.           (and
  330.             (caddr ipd)
  331.             (setq lwnl (vl-catch-all-apply
  332.               'vlax-invoke
  333.               (list (vlax-ename->vla-object lw) 'offset (- (caddr ipd)))
  334.             ))
  335.           )
  336.           (if (and lwnl (not (vl-catch-all-error-p lwnl)))
  337.             (setq lwnl (mapcar 'vlax-vla-object->ename lwnl))
  338.             (setq done t)
  339.           )
  340.         )
  341.         (cond
  342.           ( (and lwnl (not (vl-catch-all-error-p lwnl)) (= (length lwnl) 1))
  343.             (rem-vllvlli lil lwnl)
  344.           )
  345.           ( (and lwnl (not (vl-catch-all-error-p lwnl)) (> (length lwnl) 1))
  346.             (setq lwnl (vl-sort lwnl '(lambda ( a b ) (< (distance (car ipd) (vlax-curve-getclosestpointto a (car ipd))) (distance (car ipd) (vlax-curve-getclosestpointto b (car ipd)))))))
  347.             (rem-vllvlli lil lwnl)
  348.           )
  349.         )
  350.       )
  351.     )
  352.     lwnl
  353.   )
  354.  
  355.   (defun process ( lw / lwi lwx vl vli iplst tl lwnl ) ;;; vll, vlli, tll, lwnl, ppp, done - lexical global variables ;;;
  356.     (if lw
  357.       (progn
  358.         (setq vl (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (setq lwx (entget lw)))))
  359.         (if (not vll)
  360.           (setq vll vl)
  361.         )
  362.         (setq lwi (vlax-vla-object->ename (car (vlax-invoke (vlax-ename->vla-object lw) 'offset -1e-3))))
  363.         (setq vli (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget lwi))))
  364.         (if (not vlli)
  365.           (setq vlli vli)
  366.         )
  367.         (setq tl (mapcar '(lambda ( a b ) (list a b)) vl (append (cdr vl) (list (car vl)))))
  368.         (if (not tll)
  369.           (setq tll tl)
  370.         )
  371.         (repeat (* 5 (length vll))
  372.           (setq iplst nil)
  373.           (setq iplst (preprocess1 vll vlli))
  374.           (subprocess iplst)
  375.           (setq iplst nil)
  376.           (setq iplst (preprocess2 vll vlli))
  377.           (subprocess iplst)
  378.         )
  379.         (if (and lwi (not (vlax-erased-p lwi)))
  380.           (entdel lwi)
  381.         )
  382.         lwnl
  383.       )
  384.     )
  385.   )
  386.  
  387.   (or doc (setq doc (vla-get-activedocument cad)))
  388.   (or spc (setq spc (vla-get-block (setq lay (vla-get-activelayout doc)))))
  389.  
  390.   (if (= 8 (logand 8 (getvar 'undoctl)))
  391.     (vla-endundomark doc)
  392.   )
  393.   (if
  394.     (and
  395.       (setq lw (car (entsel "\nPick boundary closed polygonal LWPOLYLINE with only straight segments...")))
  396.       (= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE")
  397.       (= 1 (logand 1 (cdr (assoc 70 lwx))))
  398.       (vl-every '(lambda ( x ) (= 0.0 (cdr x))) (vl-remove-if '(lambda ( x ) (/= (car x) 42)) lwx))
  399.       (setq el (entlast) ent lw)
  400.     )
  401.     (progn
  402.       (setq lwi (vlax-vla-object->ename (car (vlax-invoke (vlax-ename->vla-object lw) 'offset -1e-3))))
  403.       (if (> (vlax-curve-getarea lwi) (vlax-curve-getarea lw))
  404.         (setq lw (rlw lw)) ;;; force main lwpolyline CCW - counter clockwise ;;;
  405.       )
  406.       (setq enti (vlax-vla-object->ename (car (vlax-invoke (vlax-ename->vla-object ent) 'offset -1e-3))))
  407.       (if (and lwi (not (vlax-erased-p lwi)))
  408.         (entdel lwi)
  409.       )
  410.       (if (not f)
  411.         (progn
  412.           (setq vlll (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget ent))))
  413.           (setq vllli (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget enti))))
  414.           (setq tlll (mapcar '(lambda ( a b ) (list a b)) vlll (append (cdr vlll) (list (car vlll)))))
  415.           (setq f t)
  416.         )
  417.       )
  418.       (initget "Yes No")
  419.       (setq ch (cond ( (getkword "\nDo you want points-offsets-lines or just lines [Yes / No] <Yes> : ") ) ( "Yes" )))
  420.       (while (not done)
  421.         (if
  422.           (and
  423.             (not (vl-catch-all-error-p (setq lwnl (vl-catch-all-apply 'process (list lw)))))
  424.             lwnl
  425.           )
  426.           (while (and (not done) (setq lww (car (vl-sort lwnl '(lambda ( a b ) (> (vlax-curve-getarea a) (vlax-curve-getarea b)))))))
  427.             (setq lwnl (vl-remove lww lwnl))
  428.             (setq lwo lww)
  429.             (setq lwnl (vl-catch-all-apply 'process (list lww)))
  430.             (if (vl-catch-all-error-p lwnl)
  431.               (setq done t)
  432.               (if (eq (car lwnl) lwo)
  433.                 (setq done t)
  434.               )
  435.             )
  436.           )
  437.           (setq done t)
  438.         )
  439.       ) ;;; main engine ;;;
  440.     )
  441.   )
  442.   (*error* nil)
  443. )
  444.  

Regards, M.R.
« Last Edit: August 10, 2023, 12:53:52 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube