Recent Posts

Pages: 1 [2] 3 4 ... 10
11
I jumped up too early... Challenge is still open... It don't give expected results on just a little wider network...
So...
Happy coding...
See ya when someone finishes...
 8-)
12
I've finished... My last updated code is fully operational and working well...

Thanks for attention and taking part in this challenge...
13
I've constructed some wrapper over external file (strcat (getvar 'tempprefix) "foo.lsp"), but it won't work... Can you check instead of me, maybe I don't see something obvious, cos' result is wrong...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:loops ( / *error* consbyblk proc process consforeach closeparen conselst body cmd osm clay pea el ell s ss sss nolstt n nn elst fn )
  2.  
  3.  
  4.   (defun *error* ( m )
  5.     (if (and bound (not (vlax-erased-p bound)))
  6.       (entdel bound)
  7.     )
  8.     (if (= 8 (logand 8 (getvar (quote undoctl))))
  9.       (if command-s
  10.         (command-s "_.UNDO" "_E")
  11.         (vl-cmdf "_.UNDO" "_E")
  12.       )
  13.     )
  14.     (if cmd
  15.       (setvar (quote cmdecho) cmd)
  16.     )
  17.     (if osm
  18.       (setvar (quote osmode) osm)
  19.     )
  20.     (if clay
  21.       (setvar (quote clayer) clay)
  22.     )
  23.     (if pea
  24.       (setvar (quote peditaccept) pea)
  25.     )
  26.     (if m
  27.       (prompt m)
  28.     )
  29.     (princ)
  30.   )
  31.  
  32.   (defun consbyblk ( blk / no )
  33.     (foreach att (vlax-invoke (vlax-ename->vla-object blk) (quote getattributes))
  34.       (if (numberp (setq no (atoi (vla-get-textstring att))))
  35.         (setq nolst (cons no nolst))
  36.       )
  37.     )
  38.   )
  39.  
  40.   (defun proc ( p / nolst bound pl ss blk )
  41.     (setq bound (car (nentselp p)))
  42.     (sssetfirst nil (ssadd bound))
  43.     (getstring "\nENTER TO CONTINUE...")
  44.     (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget bound))))
  45.     (entdel bound)
  46.     (if (= 1 (logand 1 (cdr (assoc 70 (tblsearch "LAYER" "0water nodes")))))
  47.       (progn
  48.         (vl-cmdf "_.LAYER" "_Thaw" "0water nodes")
  49.         (while (< 0 (getvar (quote cmdactive)))
  50.           (vl-cmdf "")
  51.         )
  52.       )
  53.     )
  54.     (foreach p pl
  55.       (if (setq ss (ssget "_CP" (list (mapcar (function +) (list -0.1 -0.1) p) (mapcar (function +) (list 0.1 -0.1) p) (mapcar (function +) (list 0.1 0.1) p) (mapcar (function +) (list -0.1 0.1) p)) (list (cons 0 "INSERT"))))
  56.         (progn
  57.           (setq blk (ssname ss 0))
  58.           (consbyblk blk)
  59.         )
  60.       )
  61.     )
  62.     (setq nolstt (cons nolst nolstt))
  63.   )
  64.  
  65.   (defun process ( ss p )
  66.     (if (not (vl-catch-all-error-p (vl-catch-all-apply (function vl-cmdf) (list "_.PEDIT" "_M" ss "" "_J" "" ""))))
  67.       (proc p)
  68.       (progn
  69.         (vl-cmdf "_.JOIN" ss)
  70.         (while (< 0 (getvar (quote cmdactive)))
  71.           (vl-cmdf "")
  72.         )
  73.         (proc p)
  74.       )
  75.     )
  76.   )
  77.  
  78.   (defun consforeach ( n fn )
  79.     (if (> n 0)
  80.       (progn
  81.         (write-line (strcat "(foreach e" (itoa n) " ell") fn)
  82.         (if (> n 1)
  83.           (write-line (strcat "(setq ell (vl-remove e" (itoa n) " ell))") fn)
  84.         )
  85.         (consforeach (1- n) fn)
  86.       )
  87.     )
  88.   )
  89.  
  90.   (defun closeparen ( n fn )
  91.     (if (> n 0)
  92.       (progn
  93.         (write-line ")" fn)
  94.         (closeparen (1- n) fn)
  95.       )
  96.     )
  97.   )
  98.  
  99.   (defun conselst ( n fn )
  100.     (if (> n 0)
  101.       (progn
  102.         (write-line (strcat "(setq elst (cons e" (itoa n) " elst))") fn)
  103.         (conselst (1- n) fn)
  104.       )
  105.     )
  106.   )
  107.  
  108.   (defun body ( n fn )
  109.     (write-line "(vl-cmdf \"_.UNDO\" \"_G\")" fn)
  110.       (conselst n fn)
  111.       (write-line "(vl-catch-all-apply (function vl-cmdf) (cons \"_.UNION\" elst))" fn)
  112.       (write-line "(while (< 0 (getvar (quote cmdactive)))" fn)
  113.         (write-line "(vl-cmdf \"\")" fn)
  114.       (write-line ")" fn)
  115.       (write-line "(setq el (entlast) s (ssadd))" fn)
  116.       (write-line "(setq e (vl-some (function (lambda ( x ) (if (not (vlax-erased-p x)) x))) elst))" fn)
  117.       (write-line "(cond" fn)
  118.         (write-line "( e" fn)
  119.           (write-line "(vl-cmdf \"_.EXPLODE\" e)" fn)
  120.           (write-line "(while (< 0 (getvar (quote cmdactive)))" fn)
  121.             (write-line "(vl-cmdf \"\")" fn)
  122.           (write-line ")" fn)
  123.         (write-line ")" fn)
  124.         (write-line "( t" fn)
  125.           (write-line "(vl-cmdf \"_.EXPLODE\" \"_L\")" fn)
  126.           (write-line "(while (< 0 (getvar (quote cmdactive)))" fn)
  127.             (write-line "(vl-cmdf \"\")" fn)
  128.           (write-line ")" fn)
  129.         (write-line ")" fn)
  130.       (write-line ")" fn)
  131.       (write-line "(while (setq el (entnext el))" fn)
  132.       (write-line "(ssadd el s)" fn)
  133.       (write-line ")" fn)
  134.       (write-line "(setq elst nil)" fn)
  135.       (write-line "(if (wcmatch (cdr (assoc 0 (entget (ssname s 0)))) \"LINE,ARC\")" fn)
  136.         (write-line "(process s (osnap (vlax-curve-getpointatparam (ssname s 0) 0.01) \"_nea\"))" fn)
  137.     (write-line ")" fn)
  138.     (write-line "(vl-cmdf \"_.UNDO\" \"_B\")" fn)
  139.   )
  140.  
  141.   (setq cmd (getvar (quote cmdecho)))
  142.   (setvar (quote cmdecho) 0)
  143.   (setq osm (getvar (quote osmode)))
  144.   (setvar (quote osmode) 0)
  145.   (if (= 1 (logand 1 (cdr (assoc 70 (tblsearch "LAYER" "0")))))
  146.     (progn
  147.       (vl-cmdf "_.LAYER" "_Thaw" "0")
  148.       (while (< 0 (getvar (quote cmdactive)))
  149.         (vl-cmdf "")
  150.       )
  151.     )
  152.   )
  153.   (setq clay (getvar (quote clayer)))
  154.   (setvar (quote clayer) "0")
  155.   (setq pea (getvar (quote peditaccept)))
  156.   (setvar (quote peditaccept) 1)
  157.   (if (= 8 (logand 8 (getvar (quote undoctl))))
  158.     (vl-cmdf "_.UNDO" "_E")
  159.   )
  160.   (vl-cmdf "_.UNDO" "_M")
  161.   (vl-cmdf "_.-OVERKILL" "_ALL")
  162.   (while (< 0 (getvar (quote cmdactive)))
  163.     (vl-cmdf "")
  164.   )
  165.   (vl-cmdf "_.ZOOM" "_Extents")
  166.   (setq ss (ssget "_A" (list (cons 0 "LWPOLYLINE") (cons 8 "0water"))))
  167.   (setq el (entlast))
  168.   (vl-cmdf "_.COPY" ss "" "_non" (list 0.0 0.0 0.0) "_non" (list 0.0 0.0 0.0))
  169.   (setq sss (ssadd))
  170.   (while (setq el (entnext el))
  171.     (ssadd el sss)
  172.   )
  173.   (if (= 0 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" "0water nodes")))))
  174.     (progn
  175.       (vl-cmdf "_.LAYER" "_Lock" "0water nodes")
  176.       (while (< 0 (getvar (quote cmdactive)))
  177.         (vl-cmdf "")
  178.       )
  179.     )
  180.   )
  181.   (if (= 0 (logand 1 (cdr (assoc 70 (tblsearch "LAYER" "0water nodes")))))
  182.     (progn
  183.       (vl-cmdf "_.LAYER" "_Freeze" "0water nodes")
  184.       (while (< 0 (getvar (quote cmdactive)))
  185.         (vl-cmdf "")
  186.       )
  187.     )
  188.   )
  189.   (vl-cmdf "_.REGION" sss "")
  190.   (setq ell (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex (ssget "_A" (list (cons 0 "REGION") (cons 8 "0")))))))
  191.   (vl-cmdf "_.UNDO" "_G")
  192.   (foreach el ell
  193.     (vl-cmdf "_.EXPLODE" el)
  194.     (while (< 0 (getvar (quote cmdactive)))
  195.       (vl-cmdf "")
  196.     )
  197.     (setq s (ssget "_P"))
  198.     (process s (osnap (vlax-curve-getpointatparam (ssname s 0) (/ (+ (vlax-curve-getstartparam (ssname s 0)) (vlax-curve-getendparam (ssname s 0))) 2.0)) "_nea"))
  199.   )
  200.   (vl-cmdf "_.UNDO" "_B")
  201.   (setq ell (vl-remove (setq el (car (vl-sort ell (function (lambda ( a b ) (> (vla-get-area (vlax-ename->vla-object a)) (vla-get-area (vlax-ename->vla-object b)))))))) ell))
  202.   (entdel el)
  203.   (setq nn (length ell))
  204.   (while (> nn 2)
  205.     (setq nn (1- nn))
  206.     (setq fn (open (strcat (getvar (quote tempprefix)) "foo.lsp") "w"))
  207.     (write-line "(defun foo nil" fn)
  208.     (consforeach nn fn)
  209.     (body nn fn)
  210.     (closeparen nn fn)
  211.     (write-line ")" fn)
  212.     (close fn)
  213.     (while (not (findfile (strcat (getvar (quote tempprefix)) "foo.lsp"))))
  214.     (load (strcat (getvar (quote tempprefix)) "foo.lsp"))
  215.     (foo)
  216.   )
  217.   (if (findfile (strcat (getvar (quote tempprefix)) "foo.lsp"))
  218.     (vl-file-delete (strcat (getvar (quote tempprefix)) "foo.lsp"))
  219.   )
  220.   (if (and sss (= (type sss) (quote pickset)) (< 0 (sslength sss)))
  221.     (progn
  222.       (vl-cmdf "_.ERASE" sss)
  223.       (while (< 0 (getvar (quote cmdactive)))
  224.         (vl-cmdf "")
  225.       )
  226.     )
  227.   )
  228.   (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" "0water nodes")))))
  229.     (progn
  230.       (vl-cmdf "_.LAYER" "_Unlock" "0water nodes")
  231.       (while (< 0 (getvar (quote cmdactive)))
  232.         (vl-cmdf "")
  233.       )
  234.     )
  235.   )
  236.   (if (= 1 (logand 1 (cdr (assoc 70 (tblsearch "LAYER" "0water nodes")))))
  237.     (progn
  238.       (vl-cmdf "_.LAYER" "_Thaw" "0water nodes")
  239.       (while (< 0 (getvar (quote cmdactive)))
  240.         (vl-cmdf "")
  241.       )
  242.     )
  243.   )
  244.   (setq ss (ssget "_A" (list (cons 0 "REGION") (cons 8 "0"))))
  245.   (vl-cmdf "_.ERASE" ss)
  246.   (while (< 0 (getvar (quote cmdactive)))
  247.     (vl-cmdf "")
  248.   )
  249.   (setq ss (ssget "_A" (list (cons 0 "LWPOLYLINE") (cons 8 "0water"))))
  250.   (vl-cmdf "_.DRAWORDER" ss "" "_Back")
  251.   (if (and nolstt (listp nolstt) (listp (car nolstt)))
  252.     (setq nolstt (vl-sort nolstt (function (lambda ( a b ) (< (length a) (length b))))))
  253.   )
  254.   (princ nolstt)
  255.   (*error* nil)
  256. )
  257.  
14
I test most all of them in C++

this is iterating entities in model space
AutoCAD is the fastest, followed by ZwCad

Quote
Num Entities = 291876
ARX - DbTests::OpenAllForRead, Time = 0.031310
ARX - DbTests::OpenAllForRead, Time = 0.029678
ARX - DbTests::OpenAllForRead, Time = 0.029503
ARX - DbTests::OpenAllForRead, Time = 0.030294

BRX - DbTests::OpenAllForRead, Time = 0.084655
BRX - DbTests::OpenAllForRead, Time = 0.083957
BRX - DbTests::OpenAllForRead, Time = 0.090532
BRX - DbTests::OpenAllForRead, Time = 0.085526

GRX - DbTests::OpenAllForRead, Time = 0.045137
GRX - DbTests::OpenAllForRead, Time = 0.045998
GRX - DbTests::OpenAllForRead, Time = 0.045715
GRX - DbTests::OpenAllForRead, Time = 0.046274

ZRX - DbTests::OpenAllForRead, Time = 0.041592
ZRX - DbTests::OpenAllForRead, Time = 0.042775
ZRX - DbTests::OpenAllForRead, Time = 0.040999
ZRX - DbTests::OpenAllForRead, Time = 0.042115

Num Entities = 291876
ARX - DbTests::OpenAllForWriteXform, Time = 0.709899
ARX - DbTests::OpenAllForWriteXform, Time = 0.712916
ARX - DbTests::OpenAllForWriteXform, Time = 0.710051
ARX - DbTests::OpenAllForWriteXform, Time = 0.713089

BRX - DbTests::OpenAllForWriteXform, Time = 1.374065
BRX - DbTests::OpenAllForWriteXform, Time = 1.375848
BRX - DbTests::OpenAllForWriteXform, Time = 1.338291
BRX - DbTests::OpenAllForWriteXform, Time = 1.355196

GRX - DbTests::OpenAllForWriteXform, Time = 1.447262
GRX - DbTests::OpenAllForWriteXform, Time = 1.461199
GRX - DbTests::OpenAllForWriteXform, Time = 1.489696
GRX - DbTests::OpenAllForWriteXform, Time = 1.518017

ZRX - DbTests::OpenAllForWriteXform, Time = 0.845144
ZRX - DbTests::OpenAllForWriteXform, Time = 0.842838
ZRX - DbTests::OpenAllForWriteXform, Time = 0.856382
ZRX - DbTests::OpenAllForWriteXform, Time = 0.846967
15
 :idea:Hello.
We need the compare and calculate the speeds of Stack for recursive-functions?
<Must be in different platforms  BrisCad, AutoCad, Cadian, ProgeCad
Who is the winner?
How we can calculate the speed of Stack with LISP sources?
The stack-of-call/s inside VLX is more slower than .LSP?
The stack-of-call/s inside FAS is more slower than .VLX?
 :police:
16
The recusive self function , example Consforeach is worst think, because
  you slow -down too much the speed of AutoCad(every time autocad must donloading
Why?
Do you known ? How to replace the recursive function with non-rec?
How to increase the speed of stack?
Thanks
God Bless


Code: [Select]
(defun consforeach ( n )
    (if (> n 0)
      (progn
        '(foreach (read (strcat "e" (itoa n))) ell
        (consforeach (1- n))
      )
    )
  )
17
Thanks for your help BigAl
18
Thanks for the reply BigAl, much appreciated
19
This my last post is attempt to solve, but those (foreach combos, just I can't manage to visualize better approach...

Link : https://www.cadtutor.net/forum/topic/77081-lisp-routine-to-specify-loops-in-a-network/?do=findComment&comment=615301

Thanks for attention, M.R.
20
CAD General / Re: Offset line and trim/extend
« Last post by ribarm on March 18, 2023, 10:49:58 AM »
Why don't you use double XLINES and then just EXTRIM (etrim ptinside) + (etrim ptoutside)...
Pages: 1 [2] 3 4 ... 10