Code Red > AutoLISP (Vanilla / Visual)
--={ Challenge }=-- find general solution for collecting multiple loops...
ribarm:
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.
d2010:
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: ---(defun consforeach ( n )
(if (> n 0)
(progn
'(foreach (read (strcat "e" (itoa n))) ell
(consforeach (1- n))
)
)
)
--- End code ---
ribarm:
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: ---(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 ) (vl-load-com) (defun *error* ( m ) (if (and bound (not (vlax-erased-p bound))) (entdel bound) ) (if (= 8 (logand 8 (getvar (quote undoctl)))) (if command-s (command-s "_.UNDO" "_E") (vl-cmdf "_.UNDO" "_E") ) ) (if cmd (setvar (quote cmdecho) cmd) ) (if osm (setvar (quote osmode) osm) ) (if clay (setvar (quote clayer) clay) ) (if pea (setvar (quote peditaccept) pea) ) (if m (prompt m) ) (princ) ) (defun consbyblk ( blk / no ) (foreach att (vlax-invoke (vlax-ename->vla-object blk) (quote getattributes)) (if (numberp (setq no (atoi (vla-get-textstring att)))) (setq nolst (cons no nolst)) ) ) ) (defun proc ( p / nolst bound pl ss blk ) (setq bound (car (nentselp p))) (sssetfirst nil (ssadd bound)) (getstring "\nENTER TO CONTINUE...") (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget bound)))) (entdel bound) (if (= 1 (logand 1 (cdr (assoc 70 (tblsearch "LAYER" "0water nodes"))))) (progn (vl-cmdf "_.LAYER" "_Thaw" "0water nodes") (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) ) ) (foreach p pl (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")))) (progn (setq blk (ssname ss 0)) (consbyblk blk) ) ) ) (setq nolstt (cons nolst nolstt)) ) (defun process ( ss p ) (if (not (vl-catch-all-error-p (vl-catch-all-apply (function vl-cmdf) (list "_.PEDIT" "_M" ss "" "_J" "" "")))) (proc p) (progn (vl-cmdf "_.JOIN" ss) (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) (proc p) ) ) ) (defun consforeach ( n fn ) (if (> n 0) (progn (write-line (strcat "(foreach e" (itoa n) " ell") fn) (if (> n 1) (write-line (strcat "(setq ell (vl-remove e" (itoa n) " ell))") fn) ) (consforeach (1- n) fn) ) ) ) (defun closeparen ( n fn ) (if (> n 0) (progn (write-line ")" fn) (closeparen (1- n) fn) ) ) ) (defun conselst ( n fn ) (if (> n 0) (progn (write-line (strcat "(setq elst (cons e" (itoa n) " elst))") fn) (conselst (1- n) fn) ) ) ) (defun body ( n fn ) (write-line "(vl-cmdf \"_.UNDO\" \"_G\")" fn) (conselst n fn) (write-line "(vl-catch-all-apply (function vl-cmdf) (cons \"_.UNION\" elst))" fn) (write-line "(while (< 0 (getvar (quote cmdactive)))" fn) (write-line "(vl-cmdf \"\")" fn) (write-line ")" fn) (write-line "(setq el (entlast) s (ssadd))" fn) (write-line "(setq e (vl-some (function (lambda ( x ) (if (not (vlax-erased-p x)) x))) elst))" fn) (write-line "(cond" fn) (write-line "( e" fn) (write-line "(vl-cmdf \"_.EXPLODE\" e)" fn) (write-line "(while (< 0 (getvar (quote cmdactive)))" fn) (write-line "(vl-cmdf \"\")" fn) (write-line ")" fn) (write-line ")" fn) (write-line "( t" fn) (write-line "(vl-cmdf \"_.EXPLODE\" \"_L\")" fn) (write-line "(while (< 0 (getvar (quote cmdactive)))" fn) (write-line "(vl-cmdf \"\")" fn) (write-line ")" fn) (write-line ")" fn) (write-line ")" fn) (write-line "(while (setq el (entnext el))" fn) (write-line "(ssadd el s)" fn) (write-line ")" fn) (write-line "(setq elst nil)" fn) (write-line "(if (wcmatch (cdr (assoc 0 (entget (ssname s 0)))) \"LINE,ARC\")" fn) (write-line "(process s (osnap (vlax-curve-getpointatparam (ssname s 0) 0.01) \"_nea\"))" fn) (write-line ")" fn) (write-line "(vl-cmdf \"_.UNDO\" \"_B\")" fn) ) (setq cmd (getvar (quote cmdecho))) (setvar (quote cmdecho) 0) (setq osm (getvar (quote osmode))) (setvar (quote osmode) 0) (if (= 1 (logand 1 (cdr (assoc 70 (tblsearch "LAYER" "0"))))) (progn (vl-cmdf "_.LAYER" "_Thaw" "0") (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) ) ) (setq clay (getvar (quote clayer))) (setvar (quote clayer) "0") (setq pea (getvar (quote peditaccept))) (setvar (quote peditaccept) 1) (if (= 8 (logand 8 (getvar (quote undoctl)))) (vl-cmdf "_.UNDO" "_E") ) (vl-cmdf "_.UNDO" "_M") (vl-cmdf "_.-OVERKILL" "_ALL") (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) (vl-cmdf "_.ZOOM" "_Extents") (setq ss (ssget "_A" (list (cons 0 "LWPOLYLINE") (cons 8 "0water")))) (setq el (entlast)) (vl-cmdf "_.COPY" ss "" "_non" (list 0.0 0.0 0.0) "_non" (list 0.0 0.0 0.0)) (setq sss (ssadd)) (while (setq el (entnext el)) (ssadd el sss) ) (if (= 0 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" "0water nodes"))))) (progn (vl-cmdf "_.LAYER" "_Lock" "0water nodes") (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) ) ) (if (= 0 (logand 1 (cdr (assoc 70 (tblsearch "LAYER" "0water nodes"))))) (progn (vl-cmdf "_.LAYER" "_Freeze" "0water nodes") (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) ) ) (vl-cmdf "_.REGION" sss "") (setq ell (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex (ssget "_A" (list (cons 0 "REGION") (cons 8 "0"))))))) (vl-cmdf "_.UNDO" "_G") (foreach el ell (vl-cmdf "_.EXPLODE" el) (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) (setq s (ssget "_P")) (process s (osnap (vlax-curve-getpointatparam (ssname s 0) (/ (+ (vlax-curve-getstartparam (ssname s 0)) (vlax-curve-getendparam (ssname s 0))) 2.0)) "_nea")) ) (vl-cmdf "_.UNDO" "_B") (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)) (entdel el) (setq nn (length ell)) (while (> nn 2) (setq nn (1- nn)) (setq fn (open (strcat (getvar (quote tempprefix)) "foo.lsp") "w")) (write-line "(defun foo nil" fn) (consforeach nn fn) (body nn fn) (closeparen nn fn) (write-line ")" fn) (close fn) (while (not (findfile (strcat (getvar (quote tempprefix)) "foo.lsp")))) (load (strcat (getvar (quote tempprefix)) "foo.lsp")) (foo) ) (if (findfile (strcat (getvar (quote tempprefix)) "foo.lsp")) (vl-file-delete (strcat (getvar (quote tempprefix)) "foo.lsp")) ) (if (and sss (= (type sss) (quote pickset)) (< 0 (sslength sss))) (progn (vl-cmdf "_.ERASE" sss) (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) ) ) (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" "0water nodes"))))) (progn (vl-cmdf "_.LAYER" "_Unlock" "0water nodes") (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) ) ) (if (= 1 (logand 1 (cdr (assoc 70 (tblsearch "LAYER" "0water nodes"))))) (progn (vl-cmdf "_.LAYER" "_Thaw" "0water nodes") (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) ) ) (setq ss (ssget "_A" (list (cons 0 "REGION") (cons 8 "0")))) (vl-cmdf "_.ERASE" ss) (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) (setq ss (ssget "_A" (list (cons 0 "LWPOLYLINE") (cons 8 "0water")))) (vl-cmdf "_.DRAWORDER" ss "" "_Back") (if (and nolstt (listp nolstt) (listp (car nolstt))) (setq nolstt (vl-sort nolstt (function (lambda ( a b ) (< (length a) (length b)))))) ) (princ nolstt) (*error* nil))
ribarm:
I've finished... My last updated code is fully operational and working well...
Thanks for attention and taking part in this challenge...
ribarm:
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-)
Navigation
[0] Message Index
[#] Next page
Go to full version