Leaderboard

;;; switch layer Rlx 11-oct-2022 (defun c:swl ( / _laylist lay-list pos max-pos done inp) (vl-load-com) ;;; (setq l (_laylist)) (defun _laylist ( / d r) (while (setq d (tblnext "layer" (null d)))(setq r (cons (cdr (assoc 2 d)) r))) (reverse r)) (setq lay-list (_laylist) pos (vl-position (getvar "clayer") lay-list) max-pos (1- (length lay-list))) ;;; make list with layer filters (setq lwf (_grouplayerfilterswlayernames)) (princ "\nSwitch layer (Lmouse or - = prev , Rmouse or + = next , f = filter , anyother key = exit)") (princ (strcat "\nCurrent layer is " (getvar "clayer"))) (setq done nil) (while (not done) (setq inp (vl-catch-all-apply 'grread (list nil 4 1))) (if (vl-catch-all-error-p inp) (setq done t ) (cond ;;; - or lmouse ((or (equal inp '(2 45)) (= (car inp) 3)) (if (> pos 0) (progn (setq pos (1- pos)) (setvar "clayer" (nth pos lay-list)) (princ (strcat "\rCurrent layer : " (getvar "clayer") " ... "))) (princ (strcat "\rYou've reached the first layer ( "(getvar "clayer") " ) ")) ) ) ;;; + or rmouse ((or (equal inp '(2 43)) (= (car inp) 25)) (if (< pos max-pos) (progn (setq pos (1+ pos)) (setvar "clayer" (nth pos lay-list)) (princ (strcat "\rCurrent layer : " (getvar "clayer") " ... "))) (princ (strcat "\rYou've reached the last layer ( "(getvar "clayer") " ) ")) ) ) ;;; F or f ((or (equal inp '(2 70)) (equal inp '(2 102))) (use_layer_filter)) (t (setq done t)) ) ) ) (princ) ) (defun use_layer_filter ( / lwf inp) (cond ((not (vl-consp (setq lwf (_grouplayerfilterswlayernames)))) (alert "This drawing has no layergroups")) ((not (setq inp (cfl (cons "All" (mapcar 'car lwf))))) (princ "\nLayer group selection cancelled")) (t (if (not (eq inp "All")) (setq lay-list (cadr (assoc inp lwf))) (setq lay-list (_laylist))) ) ) ;;; filtered list will have different length then total list so reset pos & pos-max (setq max-pos (1- (length lay-list))) (if (member (getvar "clayer") lay-list) (setq pos (vl-position (getvar "clayer") lay-list)) (setq pos 0)) (setvar "clayer" (nth pos lay-list)) (princ (strcat "\rCurrent layer : " (getvar "clayer") " ... ")) ) ; choose from list (cfl '("1""2""3")) (defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";}ok_cancel;}" p)(not (setq p (close p))) (< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb")(mapcar 'add_list l) (end_list) (action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)")(action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)") (start_dialog)(unload_dialog d)(vl-file-delete f)))(cond ((= r "") nil)(r r)(t nil))) ;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/retrieve-layer-names-from-group-layer-filter/td-p/8805768 ;;; Lee Mac / RJP » 2019-05-21 added list of layer names associated with filter (defun _grouplayerfilterswlayernames nil ((lambda (foo)(foo (entget (cdr (assoc 330 (entget (tblobjname "layer" "0"))))))) (lambda (enx / dic i itm rtn) (and (setq dic (cdr (assoc 360 (member '(102 . "{ACAD_XDICTIONARY") enx)))) (setq dic (cdr (assoc -1 (dictsearch dic "aclydictionary")))) (while (setq itm (dictnext dic (not itm))) (if (= "AcLyLayerGroup" (cdr (assoc 1 itm))) (setq i (assoc 300 itm) rtn (cons (list (cdr i)(mapcar '(lambda (y) (cdr (assoc 2 (entget (cdr y)))))(vl-remove-if '(lambda (x)(/= 330 (car x)))(member i itm)))) rtn)))))(reverse rtn)))) You now have letter f (or F) for filter (thanx Lee/Ron for example code I found with google)

Here I've made some improvements to overcome this issue with more int points... Also be careful with picking reference curves... And BTW., with SPLINES it won't perform reliably... So long, for now... (defun c:2cur-int-cur ( / vl-load *error* cmdfun cmderr catch_cont apply_cadr->car ftoa reversecurve mid groupbynum sysvarpreset sysvarlst sysvarvals initvalueslst fuzz ti s1 c1 q1 s2 c2 q2 k ii e1 e2 ex ) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; (defun vl-load nil (or cad (cond ( (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (setq cad (vlax-get-acad-object)) ) ( t (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 *error* ( m ) (if (= 8 (logand 8 (getvar (quote undoctl)))) (if (not (cmdfun (list "_.UNDO" "_E") t)) (cmderr 23) (if doc (vla-endundomark doc) ) ) ) (if initvalueslst (mapcar (function apply_cadr->car) initvalueslst) ) (if doc (vla-regen doc acactiveviewport) ) (if m (prompt m) ) (princ) ) (defun cmdfun ( tokenslist flag ) ;;; 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 (vl-catch-all-apply (function command-s) tokenslist))) flag ) (apply (function command-s) tokenslist) ) (if flag (apply (function vl-cmdf) tokenslist) (apply (function command) tokenslist) ) ) ) (defun cmderr ( linenum ) ;;; linenum - integer representing line number at which used (cmdfun) failed with success execution ;;; (prompt (strcat "\ncommand execution failure... error at line " (itoa linenum) " ...")) ) (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) ) ) ) ) ) ) (defun reversecurve ( curve / rlw r3dp rhpl rspl rhel rli rell rarc rci ) (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 (function append) (apply (function mapcar) (cons (function 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) ) ) ) ;; Reverse HELIX - Marko Ribar, d.i.a. (defun rhel ( hel / enx enx1 enx2 v x1 x2 x3 ) (if (= (cdr (assoc 0 (setq enx (entget hel)))) "HELIX") (progn (setq enx1 (reverse (cdr (member (cons 100 "AcDbHelix") (reverse enx)))) enx2 (member (cons 100 "AcDbHelix") enx)) (foreach a1 enx1 (cond ( (= (car a1) 40) (setq x2 (cons a1 x2)) ) ( (= (car a1) 10) (setq x3 (cons a1 x3)) ) ( t (setq x1 (cons a1 x1)) ) ) ) (setq enx2 (subst (cons 40 (distance (cdr (assoc 10 enx2)) (cdr (assoc 11 enx2)))) (assoc 40 enx2) enx2) enx2 (subst (cons 10 (mapcar (function +) (cdr (assoc 10 enx2)) (mapcar (function *) (cdr (assoc 12 enx2)) (list (* (cdr (assoc 41 enx2)) (cdr (assoc 42 enx2))) (* (cdr (assoc 41 enx2)) (cdr (assoc 42 enx2))) (* (cdr (assoc 41 enx2)) (cdr (assoc 42 enx2))))))) (assoc 10 enx2) enx2) enx2 (subst (cons 11 (cdr (car x3))) (assoc 11 enx2) enx2) enx2 (subst (cons 12 (mapcar (function -) (cdr (assoc 12 enx2)))) (assoc 12 enx2) enx2)) (entmod (append (reverse x1) (mapcar (function (lambda ( x ) (cons 40 (- (cdar x2) (cdr x))) )) x2 ) x3 enx2 ) ) (entupd hel) ) ) ) ;; Reverse LINE - Marko Ribar, d.i.a. (defun rli ( li / enx sp ep ) (if (= (cdr (assoc 0 (setq enx (entget li)))) "LINE") (progn (setq sp (cdr (assoc 10 enx))) (setq ep (cdr (assoc 11 enx))) (setq enx (subst (cons 10 ep) (assoc 10 enx) enx)) (setq enx (subst (cons 11 sp) (assoc 11 enx) enx)) (entmod enx) (entupd li) ) ) ) ;; Reverse SPLINE - Marko Ribar, d.i.a. (defun rspl ( spl / enx x12 x13 x1 x2 x3 x4 x5 ) (if (= (cdr (assoc 0 (setq enx (entget spl)))) "SPLINE") (progn (foreach a1 enx (cond ( (= (car a1) 12) (setq x13 (cons (cons 13 (mapcar (function -) (cdr a1))) x13)) ) ( (= (car a1) 13) (setq x12 (cons (cons 12 (mapcar (function -) (cdr a1))) x12)) ) ( (= (car a1) 40) (setq x2 (cons a1 x2)) ) ( (= (car a1) 10) (setq x3 (cons a1 x3)) ) ( (= (car a1) 41) (setq x4 (cons a1 x4)) ) ( (= (car a1) 11) (setq x5 (cons a1 x5)) ) ( t (setq x1 (cons a1 x1)) ) ) ) (entmod (append (reverse x1) x12 x13 (mapcar (function (lambda ( x ) (cons 40 (- (cdar x2) (cdr x))) )) x2 ) (if x4 (apply (function append) (mapcar (function (lambda ( a b ) (list a b) )) x3 x4 ) ) x3 ) x5 ) ) (entupd spl) ) ) ) ;; Reverse 3DPOLYLINE - Marko Ribar, d.i.a. (defun r3dp ( 3dp / r3dppol typ ) (defun r3dppol ( 3dp / v p pl sfa var ) (setq v 3dp) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (setq p (cdr (assoc 10 (entget v))) pl (cons p pl)) ) (setq pl (apply (function append) pl) sfa (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pl))))) (vlax-safearray-fill sfa pl) (setq var (vlax-make-variant sfa)) (vla-put-coordinates (vlax-ename->vla-object 3dp) var) (entupd 3dp) ) (setq typ (vla-get-type (vlax-ename->vla-object 3dp))) (vla-put-type (vlax-ename->vla-object 3dp) acsimplepoly) (r3dppol 3dp) (if typ (vla-put-type (vlax-ename->vla-object 3dp) typ)) (entupd 3dp) ) ;; Reverse old heavy 2d POLYLINE - Marko Ribar, d.i.a. - sub functions by Roy at Theswamp.org (defun rhpl ( hpl / KGA_List_Divide_3 KGA_List_IndexSeqMakeLength KGA_Geom_PolylineReverse ) (defun KGA_List_Divide_3 ( lst / ret ) (repeat (/ (length lst) 3) (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret) lst (cdddr lst)) ) (reverse ret) ) ; Make a zero based list of integers. (defun KGA_List_IndexSeqMakeLength ( len / ret ) (repeat (rem len 4) (setq ret (cons (setq len (1- len)) ret)) ) (repeat (/ len 4) (setq ret (vl-list* (- len 4) (- len 3) (- len 2) (- len 1) ret) len (- len 4)) ) ret ) ; Obj must be an "AcDb2dPolyline" of the acsimplepoly type or an "AcDbPolyline". (defun KGA_Geom_PolylineReverse ( obj / typ bulgeLst idxLst ptLst widLst conWid v vx ) (setq typ (vla-get-type obj)) (vla-put-type obj acsimplepoly) (setq ptLst (KGA_List_Divide_3 (vlax-get obj 'coordinates)) idxLst (KGA_List_IndexSeqMakeLength (1+ (length ptLst))) v (vlax-vla-object->ename obj)) (while (= (cdr (assoc 0 (setq vx (entget (setq v (entnext v)))))) "VERTEX") (setq widLst (cons (list (cdr (assoc 40 vx)) (cdr (assoc 41 vx))) widLst) bulgeLst (cons (cdr (assoc 42 vx)) bulgeLst)) ) (if (vl-catch-all-error-p (setq conWid (vl-catch-all-apply (function vla-get-constantwidth) (list obj)))) (mapcar (function (lambda ( idx pt bulge widSub ) (vla-put-coordinate obj idx (vlax-3d-point pt)) (vla-setbulge obj idx (- bulge)) (vla-setwidth obj idx (cadr widSub) (car widSub)) )) idxLst (reverse ptLst) (append (cdr bulgeLst) (list (car bulgeLst)) ) (append (cdr widLst) (list (car widLst)) ) ) (progn (mapcar (function (lambda ( idx pt bulge widSub ) (vla-put-coordinate obj idx (vlax-3d-point pt)) (vla-setbulge obj idx (- bulge)) )) idxLst (reverse ptLst) (append (cdr bulgeLst) (list (car bulgeLst)) ) ) (vla-put-constantwidth obj conWid) ) ) (if typ (vla-put-type obj typ)) ) (KGA_Geom_PolylineReverse (vlax-ename->vla-object hpl)) (entupd hpl) ) (defun rell ( ell / ELL:point->param ellx ocs p1 p2 dxf dxf41 dxf42 ) (defun ELL:point->param ( dxf pnt / ang ocs ) (setq ocs (cdr (assoc 210 dxf)) ang (- (angle (trans (cdr (assoc 10 dxf)) 0 ocs) (trans pnt 0 ocs)) (angle (list 0.0 0.0) (trans (cdr (assoc 11 dxf)) 0 ocs)) ) ) (atan (sin ang) (* (cdr (assoc 40 dxf)) (cos ang))) ) (setq ellx (entget ell)) (setq ocs (cdr (assoc 210 ellx))) (setq p1 (vlax-curve-getstartpoint ell) p2 (vlax-curve-getendpoint ell)) (setq dxf (list (assoc 10 ellx) (cons 11 (mapcar (function -) (cdr (assoc 11 ellx)))) (assoc 40 ellx) (cons 210 (mapcar (function -) ocs)))) (if (and (equal p1 (mapcar (function +) (cdr (assoc 10 ellx)) (cdr (assoc 11 ellx))) 1e-6) (equal p2 (mapcar (function +) (cdr (assoc 10 ellx)) (cdr (assoc 11 ellx))) 1e-6)) (setq dxf41 0.0 dxf42 (* 2 pi)) (setq dxf41 (ELL:point->param dxf p2) dxf42 (ELL:point->param dxf p1)) ) (setq ellx (subst (cons 11 (mapcar (function -) (cdr (assoc 11 ellx)))) (assoc 11 ellx) ellx)) (setq ellx (subst (cons 41 dxf41) (assoc 41 ellx) ellx)) (setq ellx (subst (cons 42 dxf42) (assoc 42 ellx) ellx)) (setq ellx (subst (cons 210 (mapcar (function -) ocs)) (assoc 210 ellx) ellx)) (entupd (cdr (assoc -1 (entmod ellx)))) ) (defun rarc ( arc / arcx cw ocs dxf50 dxf51 ) (setq arcx (entget arc)) (setq cw (trans (cdr (assoc 10 arcx)) arc 0)) (setq ocs (cdr (assoc 210 arcx))) (setq dxf50 (cdr (assoc 50 arcx)) dxf51 (cdr (assoc 51 arcx))) (setq arcx (subst (cons 50 (- pi dxf51)) (assoc 50 arcx) arcx)) (setq arcx (subst (cons 51 (- pi dxf50)) (assoc 51 arcx) arcx)) (setq arcx (subst (cons 10 (trans cw 0 (mapcar (function -) ocs))) (assoc 10 arcx) arcx)) (setq arcx (subst (cons 210 (mapcar (function -) ocs)) (assoc 210 arcx) arcx)) (entupd (cdr (assoc -1 (entmod arcx)))) ) (defun rci ( ci / cix cw ocs ) (setq cix (entget ci)) (setq cw (trans (cdr (assoc 10 cix)) ci 0)) (setq ocs (cdr (assoc 210 cix))) (setq cix (subst (cons 10 (trans cw 0 (mapcar (function -) ocs))) (assoc 10 cix) cix)) (setq cix (subst (cons 210 (mapcar (function -) ocs)) (assoc 210 cix) cix)) (entupd (cdr (assoc -1 (entmod cix)))) ) (cond ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDbLine") (rli curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDbHelix") (rhel curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDb2dPolyline") (rhpl curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDb3dPolyline") (r3dp curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDbPolyline") (rlw curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDbSpline") (rspl curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDbEllipse") (rell curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDbArc") (rarc curve) ) ( (= (cdr (assoc 100 (reverse (entget curve)))) "AcDbCircle") (rci curve) ) ) ) (defun mid ( p1 p2 ) (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0) )) p1 p2 ) ) (defun groupbynum ( lst n / sub lll ) (defun sub ( m n / ll q ) (cond ( (and m (< (length m) n)) (repeat (- n (length m)) (setq m (append m (list nil))) ) (setq ll (vl-remove-if-not (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m)) (setq lll (cons ll lll)) (setq q nil) (sub (vl-remove-if (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m) n) ) ( m (setq ll (vl-remove-if-not (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m)) (setq lll (cons ll lll)) (setq q nil) (sub (vl-remove-if (function (lambda ( x ) (setq q (if (not q) 0 (1+ q))) (< q n))) m) n) ) ( t (reverse lll) ) ) ) (sub lst n) ) (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 ) ) ) (if (= 8 (logand 8 (getvar (quote undoctl)))) (if (not (cmdfun (list "_.UNDO" "_E") t)) (cmderr 551) (if doc (vla-endundomark doc) ) ) ) (if (not (cmdfun (list "_.UNDO" "_M") t)) (cmderr 558) (if doc (vla-startundomark doc) ) ) (initget 6) (setq fuzz (cond ( (getreal "\nSpecify fuzz distance value per intersecting points advancing segment check <0.25> : ") ) (0.25) ) ) (if (and (setq s1 (entsel "\nPick first curve from the outter side of intermeeting...")) (setq c1 (car s1)) (setq q1 (cadr s1)) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list c1)))) (setq s2 (entsel "\nPick second curve from the outter side of intermeeting...")) (setq c2 (car s2)) (setq q2 (cadr s2)) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list c2)))) ) (progn (setq ti (car (_vl-times))) (if (and (setq ii (vlax-invoke (vlax-ename->vla-object c1) (quote intersectwith) (vlax-ename->vla-object c2) acextendnone)) (setq ii (groupbynum ii 3)) (vl-every (function (lambda ( a b ) (not (equal a b 1e-6)))) ii (cdr ii)) ) (progn (setq k 0) (setq q1 (trans (osnap q1 "_nea") 1 0)) (setq q2 (trans (osnap q2 "_nea") 1 0)) (if (not (cmdfun (list "_.BREAK" c1 "_non" (trans q1 0 1) "_non" (trans (vlax-curve-getpointatparam c1 (+ 0.05 (vlax-curve-getparamatpoint c1 q1))) 0 1)) t)) (cmderr 594) (setq k (1+ k)) ) (setq s1 (ssadd)) (if (not (vlax-erased-p c1)) (progn (setq e1 c1) (setq e2 (entlast)) ) (progn (setq e2 (entlast)) (entdel e2) (setq e1 (entlast)) (entdel e2) ) ) (ssadd e1 s1) (ssadd e2 s1) (if (not (cmdfun (list "_.JOIN" s1 "") t)) (cmderr 613) (setq k (1+ k)) ) (cond ( (and (not (vlax-erased-p e1)) (not (vlax-erased-p e2)) (equal (car ii) (vlax-curve-getclosestpointto e1 (car ii)) 1e-3) ) (setq c1 e1) ) ( (and (not (vlax-erased-p e1)) (not (vlax-erased-p e2)) (equal (car ii) (vlax-curve-getclosestpointto e2 (car ii)) 1e-3) ) (setq c1 e2) ) ( (and (not (vlax-erased-p e1)) (vlax-erased-p e2) (equal (car ii) (vlax-curve-getclosestpointto e1 (car ii)) 1e-3) ) (setq c1 e1) ) ( (and (vlax-erased-p e1) (not (vlax-erased-p e2)) (equal (car ii) (vlax-curve-getclosestpointto e2 (car ii)) 1e-3) ) (setq c1 e2) ) ( (equal (car ii) (vlax-curve-getclosestpointto (entlast) (car ii)) 1e-3) (setq c1 (entlast)) ) ) (if (not (cmdfun (list "_.BREAK" c2 "_non" (trans q2 0 1) "_non" (trans (vlax-curve-getpointatparam c2 (+ 0.05 (vlax-curve-getparamatpoint c2 q2))) 0 1)) t)) (cmderr 654) (setq k (1+ k)) ) (setq s2 (ssadd)) (if (not (vlax-erased-p c2)) (progn (setq e1 c2) (setq e2 (entlast)) ) (progn (setq e2 (entlast)) (entdel e2) (setq e1 (entlast)) (entdel e2) ) ) (ssadd e1 s2) (ssadd e2 s2) (if (not (cmdfun (list "_.JOIN" s2 "") t)) (cmderr 673) (setq k (1+ k)) ) (cond ( (and (not (vlax-erased-p e1)) (not (vlax-erased-p e2)) (equal (car ii) (vlax-curve-getclosestpointto e1 (car ii)) 1e-3) ) (setq c2 e1) ) ( (and (not (vlax-erased-p e1)) (not (vlax-erased-p e2)) (equal (car ii) (vlax-curve-getclosestpointto e2 (car ii)) 1e-3) ) (setq c2 e2) ) ( (and (not (vlax-erased-p e1)) (vlax-erased-p e2) (equal (car ii) (vlax-curve-getclosestpointto e1 (car ii)) 1e-3) ) (setq c2 e1) ) ( (and (vlax-erased-p e1) (not (vlax-erased-p e2)) (equal (car ii) (vlax-curve-getclosestpointto e2 (car ii)) 1e-3) ) (setq c2 e2) ) ( (equal (car ii) (vlax-curve-getclosestpointto (entlast) (car ii)) 1e-3) (setq c2 (entlast)) ) ) (if (> (vlax-curve-getparamatpoint c1 (car ii)) (vlax-curve-getparamatpoint c1 (cadr ii))) (setq c1 (reversecurve c1)) ) (if (> (vlax-curve-getparamatpoint c2 (car ii)) (vlax-curve-getparamatpoint c2 (cadr ii))) (setq c2 (reversecurve c2)) ) (setq ii (mapcar (function (lambda ( x ) (trans (mid (vlax-curve-getpointatparam c1 (+ (- (vlax-curve-getparamatdist c1 (+ fuzz (vlax-curve-getdistatpoint c1 x)) ) (vlax-curve-getparamatdist c1 (vlax-curve-getdistatpoint c1 x) ) ) (vlax-curve-getparamatpoint c1 x) ) ) (vlax-curve-getpointatparam c2 (+ (- (vlax-curve-getparamatdist c2 (+ fuzz (vlax-curve-getdistatpoint c2 x)) ) (vlax-curve-getparamatdist c2 (vlax-curve-getdistatpoint c2 x) ) ) (vlax-curve-getparamatpoint c2 x) ) ) ) 0 1 ) )) ii ) ) (if (not (and (/= k 0) (cmdfun (list "_.UNDO" k) t) ) ) (cmderr 765) ) (foreach p ii (if (not (cmdfun (list "_.-BOUNDARY" "_A" "_O" "_P" "_I" "_Y" "_B" "_N" (ssadd c1 (ssadd c2)) "" "" "_non" p "") t)) (if (not (cmdfun (list "_.-BOUNDARY" "_A" "_O" "_R" "_I" "_Y" "_B" "_N" (ssadd c1 (ssadd c2)) "" "" "_non" p "") t)) (cmderr 770) ) ) (if (assoc 62 (setq ex (entget (entlast)))) (setq ex (subst (cons 62 3) (assoc 62 ex) ex)) (setq ex (append ex (list (cons 62 3)))) ) (entupd (cdr (assoc -1 (entmod ex)))) (sssetfirst nil (ssadd (entlast))) ) (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...") (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...") ) (prompt "\nInvalid curves relationship... Curves don't intersect in 2 distinct points...") ) ) (prompt "\nMissed, or picked entity not curve...") ) (*error* nil) )

Earlier you mentioned you'd like it so that the layers of the texts and everything would be better off being separate, so that editing becomes easier. So that's what I thought you meant. Follow the format as shown in the attached CSV and the following LISP code should be what you're after. I've left flexible settings at the beginning of the code, in case you want to tamper around some settings. Though, I wasn't too sure what the first column in that file is supposed to do. Sample Borehole.csv Borehole.lsp

Don't have time for testing, but I suppose it should work... (defun c:3dc-trim ( / vl-load *error* cmdfun cmderr catch_cont apply_cadr->car ftoa sysvarpreset sysvarlst sysvarvals initvalueslst ti c1 c2 ip c1x c2x ) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; (defun vl-load nil (or cad (cond ( (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (setq cad (vlax-get-acad-object)) ) ( t (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 *error* ( m ) (if (= 8 (logand 8 (getvar (quote undoctl)))) (if (not (cmdfun (list "_.UNDO" "_E") t)) (cmderr 23) (if doc (vla-endundomark doc) ) ) ) (if initvalueslst (mapcar (function apply_cadr->car) initvalueslst) ) (if doc (vla-regen doc acactiveviewport) ) (if m (prompt m) ) (princ) ) (defun cmdfun ( tokenslist flag ) ;;; 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 (vl-catch-all-apply (function command-s) tokenslist))) flag ) (apply (function command-s) tokenslist) ) (if flag (apply (function vl-cmdf) tokenslist) (apply (function command) tokenslist) ) ) ) (defun cmderr ( linenum ) ;;; linenum - integer representing line number at which used (cmdfun) failed with success execution ;;; (prompt (strcat "\ncommand execution failure... error at line " (itoa linenum) " ...")) ) (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 ) ) ) (if (= 8 (logand 8 (getvar (quote undoctl)))) (if (not (cmdfun (list "_.UNDO" "_E") t)) (cmderr 229) (if doc (vla-endundomark doc) ) ) ) (if (not (cmdfun (list "_.UNDO" "_M") t)) (cmderr 236) (if doc (vla-startundomark doc) ) ) (if (and (setq c1 (car (entsel "\nPick curve you want to trim with vertical plane of next curve..."))) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list c1)))) (setq c2 (car (entsel "\nPick curve to trim with..."))) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list c2)))) ) (progn (setq ti (car (_vl-times))) (if (setq ip (inters (mapcar (function +) (list 0.0 0.0) (trans (vlax-curve-getstartpoint c1) 0 1) ) (mapcar (function +) (list 0.0 0.0) (trans (vlax-curve-getendpoint c1) 0 1) ) (mapcar (function +) (list 0.0 0.0) (trans (vlax-curve-getstartpoint c2) 0 1) ) (mapcar (function +) (list 0.0 0.0) (trans (vlax-curve-getendpoint c2) 0 1) ) ) ) (progn (setq ip (vlax-curve-getclosestpointtoprojection c1 ip (trans (list 0.0 0.0 1.0) 1 0 t))) (if (not (cmdfun (list "_.BREAK" c1 "_non" (trans ip 0 1) "_non" (trans ip 0 1)) t)) (cmderr 274) ) (if (not (vlax-erased-p c1)) (setq c2 (entlast)) (progn (setq c2 (entlast)) (entdel c2) (setq c1 (entlast)) (entdel c2) ) ) (if (assoc 62 (setq c1x (entget c1))) (setq c1x (subst (cons 62 (1+ (rem (cdr (assoc 62 c1x)) 256))) (assoc 62 c1x))) (setq c1x (append c1x (list (cons 62 1)))) ) (if (assoc 62 (setq c2x (entget c2))) (setq c2x (subst (cons 62 (1+ (1+ (rem (cdr (assoc 62 c2x)) 256)))) (assoc 62 c2x))) (setq c2x (append c2x (list (cons 62 2)))) ) (entupd (cdr (assoc -1 (entmod c1x)))) (entupd (cdr (assoc -1 (entmod c2x)))) (prompt "\nTrimmed curve broken into 2 parts... Remove part for trim manually and leave desired part...") (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...") ) (prompt "\nInvalid curves relationship... Curves don't have vertical apparent intersection of current UCS...") ) ) (prompt "\nMissed, or picked entity not curve...") ) (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...") (*error* nil) )

just for fun ;;; switch layer Rlx 11-oct-2022 (defun c:swl ( / _laylist lay-list cur-lay pos max-pos done inp) (vl-load-com) ;;; (setq l (_laylist)) (defun _laylist ( / d r) (while (setq d (tblnext "layer" (null d)))(setq r (cons (cdr (assoc 2 d)) r))) r) (setq lay-list (acad_strlsort (_laylist)) cur-lay (getvar "clayer") pos (vl-position cur-lay lay-list) max-pos (1- (length lay-list))) (princ "\nSwitch layer (Lmouse or - = prev , Rmouse or + = next , anyother key = exit)") (princ (strcat "\nCurrent layer is " (getvar "clayer"))) (setq done nil) (while (not done) (setq inp (vl-catch-all-apply 'grread (list nil 4 1))) (if (vl-catch-all-error-p inp) (setq done t ) (cond ;;; - or lmouse ((or (equal inp '(2 45)) (= (car inp) 3)) (if (> pos 0) (progn (setq pos (1- pos)) (setvar "clayer" (nth pos lay-list)) (princ (strcat "\rCurrent layer is now " (getvar "clayer")))) (princ "\rYou've reached the first layer") ) ) ;;; + or rmouse ((or (equal inp '(2 43)) (= (car inp) 25)) (if (< pos max-pos) (progn (setq pos (1+ pos)) (setvar "clayer" (nth pos lay-list)) (princ (strcat "\rCurrent layer is now " (getvar "clayer")))) (princ "\rYou've reached the last layer") ) ) (t (setq done t)) ) ) ) )

Yeah prob on the best idea to using lowercase L as the variable there to hard to see the difference with the fonts I use.

Hello Have to do a job that involves around 3000 loops + 2500 connection diagrams & IO-lists. Bottom line was, either I do it in half of the time and half of the money or else... (the job goes overseas) For example a loop diagram has a transmitter , connected to a Junction Box , then to a control panel + IO panel. Loops have to be made as-built (update revision, remove clouds etc). Ok already have an app for that. But I also have to check each loop against JB and CP channel (oh crap...) So I came up with the idea to first read all the titleblock titles in the project folder and save this to a (txt) file. Then, having the loop open in AutoCad , I wanted to be able to either type in part of the title in the search list box or select the JB or CP symbol and open the drawing. And that's when I decided to create my very own BFF (Bulk File Finder) App is still in its beta but so far it seems to be doing what I hoped it to do. (but some little points may yet come to surface , but hey , baby is only one weekend old so gimme a break) Make sure you put in (1) blockname of your (title)block , (2) name(s) of attributes with the titles in it, separated by comma's , (3) select your drawing source folder and (4) choose create (don't forget to save it afterwards) In the top left listbox (green) you can put in some search strings and you can also save this. When all this is done and you press ok , it should find all the drawing (titles) matching the search criterea. Some of the Select and Find buttons (purple section) are not working yet because those will involve some company special ops. Most of my time went into the interface and progress bar thats activated when scanning for folders, drawings & titles. Maybe it will be helpfull to others , maybe not because it might be too specific to my own situation but I present it on an as-it-is basis and because its been a while I posted something and posting on CadTutor seems to be getting rarer. If its not working or helpfull : trashcan , yes you can , because of my workload I don't have much time to do user request's RlxMyBFF.lsp

Maybe try contacting Lee he has a "Contact" on his web site. Lee-mac.com