I have in my hands something similar to @vladimir_michl , but it's different, but free...
If someone can find any benefit it'll be great...
So long from me, till now...
(defun c:unfoldrs ( / *error* tttt wcs initvalueslst ucsf ti rs 3dfs 3dfx dxf10 dxf11 dxf12 dxf13 2dxfs sort )
(vl-load-com)
(defun *error* ( m )
(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 tttt) (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 tttt ( 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
)
(setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;;
(while (not (setq rs (car (entsel "\nPick rulesurface..."))))
(prompt "\nMissed... Try again...")
)
(setq ti (car (_vl-times)))
(setq 3dfs (mapcar 'vlax-vla-object->ename (safearray-value (variant-value (vla-explode (vlax-ename->vla-object rs))))))
(foreach 3df 3dfs
(setq dxf10 (cdr (assoc 10 (setq 3dfx (entget 3df)))))
(setq dxf11 (cdr (assoc 11 3dfx)))
(setq dxf12 (cdr (assoc 12 3dfx)))
(setq dxf13 (cdr (assoc 13 3dfx)))
(setq 2dxfs (list (car (setq sort (vl-sort (list dxf10 dxf11 dxf12 dxf13) '(lambda ( a b ) (< (caddr a) (caddr b)))))) (cadr sort)))
(exe (list "_.UCS" "_ZA" "_non" (car 2dxfs) "_non" (cadr 2dxfs)))
(exe (list "_.ROTATE" 3df "" "_non" (list 0.0 0.0) "_R" "_non" (list 0.0 0.0) "_non" (mapcar '+ '(0.0 0.0) (trans (caddr sort) 0 1)) "_non" (list 1e+10 0.0)))
(exe (list "_.UCS" "_P"))
)
(prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
(prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
(*error* nil)
)
Marko Ribar, d.i.a. (graduated engineer of architecture)
