@johnw wrote:
Any assistance would be appreciated!
You got it, assistance it is
(Defun c:Demo (/ opt msg)
(initget 1 "A B C")
(setq msg "\nDelete "
opt (getkword
"\nChoose option [A | Delete B & C/B | Delete A & C/C | Delete A & B]: "
)
)
(foreach lay (Layoutlist) ;<-this is where the layout names are listed
(princ (Strcat
(cond
((and (eq opt "A") (wcmatch lay "*-B,*-C")) msg)
((and (eq opt "B") (wcmatch lay "*-A,*-C")) msg)
((and (eq opt "C") (wcmatch lay "*-A,*-B")) msg)
(T (strcat "\nDo nothing with "))
)
lay
)
)(princ)
)
)HTh
Thanks for the quick turnaround! I ran the routine and it states "delete" certain tabs, but the tabs remain in the drawing. Please see image attached.
@johnw wrote:
Thanks for the quick turnaround! I ran the routine and it states "delete" certain tabs, but the tabs remain in the drawing. Please see image attached.
My bad @johnw, the post was intended to show you how to go about dealing with conditions.
Anyway here you go.
(Defun c:Demo (/ deltab opt msg)
(defun deltab (nm)
(command "_Layout" "_delete" nm)
)
(initget 1 "A B C")
(setq msg "\nDelete "
opt (getkword
"\nChoose option [A | Delete B & C/B | Delete A & C/C | Delete A & B]: "
)
)
(setvar 'ctab "Model")
(foreach lay (Layoutlist) ;<-this is where the layout names are listed
(cond
((and (eq opt "A") (wcmatch lay "*-B,*-C")) (deltab lay))
((and (eq opt "B") (wcmatch lay "*-A,*-C")) (deltab lay))
((and (eq opt "C") (wcmatch lay "*-A,*-B")) (deltab lay))
(T (princ (strcat "\nDo nothing with " lay)))
)
)(princ)
)HTH
@johnw wrote:
.... I have numerous tabs with odd names, is there a way I can add them to a list and any tab names within this list never get deleted? ....
If the odd names would never end in -A, -B or -C, you don't need to worry about them with the code already suggested. If any of them might ever have one of those endings [but be odd in other aspects, whatever they are], then a list of them would be appropriate, which could be checked against in the tab-name test, along with testing for the ending:
(and (wcmatch ...) (not (member ...)))
@johnw wrote:
Sorry, Loaded and ran again.... but same results, no tabs are getting deleted....
I dont see a reason it would not get deleted.
Do me a favor and paste this on your command line (Layoutlist) and show me what you get.
You need to remember the string needs to match with the pattern e.g.
(wcmatch "4-B" "*-B,*-C" ) will return T but (wcmatch "4 - B" "*-B,*-C" ) will be nil.
You need to tell us what other conditions you have for layout tab names, is it always have a space between the characters? or both can happen, we can add more filters for that if needed.
@johnw wrote:
The command worked once I removed the spaces on each side of the DASH!!!! It would be nice if the command would also recognize if there were spaces on each side of the dash as well, a space on one side of the dash or the other, just in case someone didn't follow procedure, if that's not too difficult to accomplish. Thank you.
Sure, Tell me, are there any other layout tab names that we need to consider ? a name that could be mistaken as a hit, something like "This-A" or "That-B", we can include this as part of this as suggested by@ВeekeeCZ
(setq never "COVID-19,TR-1,THIS-A,MOSTPRECIOUS,THAT-B,DELTA VARIANT")
or any other conditions that you may think of.
Times up 🙂
(Defun c:Delabc (/ opt msg never f)
(setq never "COVID-19,TR-1,THIS-A,MOSTPRECIOUS,THAT-B,DELTA VARIANT")
(initget 1 "A B C")
(setq msg "\nDelete "
opt (getkword
"\nChoose option [A | Delete B & C/B | Delete A & C/C | Delete A & B]: "
)
)
(Setq f (Cdr (assoc opt '(("A" "B" "C") ("B" "A" "C") ("C" "A" "B")))))
(setvar 'ctab "Model")
(foreach lay (Layoutlist) ;<-this is where the layout names are listed
(cond
((wcmatch lay never))
((vl-some '(lambda (p)
(if (wcmatch lay (Strcat p (car f) "," p (Cadr f) )) p))
'("*-" "*- "))
(command "_Layout" "_delete" lay)
)
)
)
(princ)
)
@johnw wrote:
I think if there's something that shouldn't be erased but has a -A etc, I can add them to the "NEVER" list and that way they would remain. I tested that by adding COV-A to the never list and hit "B" in the command. The COV-A remained while all other "-A" items were erased.
That's good to know,
Refer to the code at post # 13 to recognize all this pattern
("*-" "*- " "* -" "* - ")
Command: Delabc
Choose option [A | Delete B & C/B | Delete A & C/C | Delete A & B]: B
Let me know how it goes.
@johnw wrote:
.... It would be nice if the command would also recognize if there were spaces on each side of the dash as well, a space on one side of the dash or the other, just in case ....
If the A/B/C letter is always at the end of the name, then you don't need to check for a possible space before the dash [whether or not in combination with one after it]. You can check for only the endings -A or - A [and similarly for B and C].
@Kent1Cooper wrote:
... You can check for only the endings -A or - A [and similarly for B and C].
Yup that make sense @Kent1Cooper, It could be just 2 wildcard
(vl-some '(lambda (p)
(if (wcmatch lay (Strcat p (car f) "," p (Cadr f) )) p))
'("*-" "*- "))
Good catch
@johnw wrote:
I have numerous layout tabs for different elevations -A, -B, and -C. If I wish to keep all -A layout tabs, I don't know how to automatically delete all -B and -C tabs. Or if I need - B, how do I delete -A and -C tabs?
Any assistance would be appreciated!
(defun c:Demo6 ( / _OptSel _sort _getOptions optList _sel _Group _LayDes _layFilter _DelMoveWindow
aDoc Layers fltr f5 ABC:Opt ABC OptElev tpoint Opt:Num Num Num:Opt OptElev
ThisList from )
;;; pBe Apr 2022 ;;
(defun _OptSel (lst / cnt iStr gStr)
;; CodeDing Original ;;
(setq cnt 0 iStr "" gStr "")
(while (<= (setq cnt (1+ cnt)) (length lst))
(setq iStr (strcat iStr (itoa cnt) " "))
(setq gStr (strcat gStr
(itoa cnt)
" . "
(strcat (car (nth (1- cnt) lst)) " | "
(cadr (nth (1- cnt) lst)))
"/"
)
)
)
(setq iStr (substr iStr 1 (1- (strlen iStr)))
gStr (substr gStr 1 (1- (strlen gStr)))
)
(initget 1 iStr)
(setq ans (getkword (strcat "\nChoose Option: [" gStr "]: ")))
(nth (1- (atoi ans)) lst)
)
(defun _sort (l)(vl-sort l '(lambda (a b)(< (car a)(car b)))))
(defun _Opt (str)
(cond
((not (setq p (vl-string-position 95 str))) )
((list (substr str 1 p)(substr str (1+ p))))
)
)
(defun _getOptions (layers pre / d ln l l#)
(vlax-for lay layers
(setq d (list (setq ln (vla-get-name lay)) (vla-get-Description lay)))
(cond
((wcmatch ln "*|*") )
((wcmatch (strcase ln) (strcase pre))
(setq l (cons d l )))
)
)
(if l (_sort l))
)
(defun _sel (l ss / i e ln ll ur pts lst )
(repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (setq i (1- i))))
Ln (vla-get-layer e ))
(vla-GetBoundingBox e 'll 'ur)
(setq pts (mapcar 'vlax-safearray->list (list ll ur)))
(if
(and (assoc Ln l)(not (assoc Ln lst)))
(setq lst (cons (list Ln (_LayDes Ln Layers) pts ) lst))
)
)
(_sort lst)
)
(defun _Group (l / a lst)
(while (setq a (car l))
(setq lst
(if (setq f (assoc (Car (setq o (_Opt (Car a)))) lst))
(subst (list (car f)(cadr f)(cons (cadr o) (caddr f))) f lst)
(cons (list (car o) (cadr a)(cdr o) (caddr a)) lst)
)
)
(setq l (cdr l))
)
(reverse lst)
)
(defun _LayDes (ln lColl)
(vla-get-description (vla-item lColl ln)))
(defun _layFilter (l)
(apply 'strcat (mapcar '(lambda (n)(strcat n ",")) (mapcar 'car l )))
)
(defun _DelMoveWindow (l m / d n )
(if (setq d (ssget "C" (car l) (cadr l) nil))
(repeat (setq n (sslength d))
(setq e (vlax-ename->vla-object (ssname d (setq n (1- n)))))
(if m
(vlax-invoke e 'Move (car m) (cadr m))
(vla-delete e)
)
)
)
l
)
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Layers (vla-get-layers aDoc)
fltr '((0 . "LWPOLYLINE")(410 . "Model")))
(vla-ZoomExtents (vlax-get-acad-object))
(setq f5 '(foreach itm ThisList
(princ (strcat "\nRemoving Option | " (Car itm) ":" (Cadr itm)))
(foreach opt_ (caddr itm)
(and (setq f (assoc (strcat (Car itm) opt_) Num))
(_DelMoveWindow (caddr f) nil)
)
)
)
)
(if
(and
(setq ABC:Opt (_getOptions Layers "OPT-@"))
(setq ABC (ssget "_X" (append fltr
(list (cons 8 (_layFilter ABC:Opt))))))
(setq ABC (_sel ABC:Opt ABC))
(setq OptElev (_OptSel ABC))
(cond
((eq (car OptElev) (caar ABC))
(foreach opt (vl-remove OptElev ABC)
(_DelMoveWindow (caddr opt) nil)))
( T (_DelMoveWindow (setq tpoint (caddr (assoc (caar ABC) ABC))) nil)
(_DelMoveWindow (caddr OptElev) (list (caaddr OptElev) (car tpoint)))
(foreach opt (vl-remove OptElev (cdr ABC))
(_DelMoveWindow (caddr opt) nil))
)
)
(setq Opt:Num (_getOptions Layers "OPT-#*"))
(setq Num (ssget "_X" (append fltr
(list (cons 8 (_layFilter Opt:Num))))))
)
(progn
(setq Num (_sel Opt:Num Num))
(setq Num:Opt (_Group Num))
(setq OptElev (_OptSel Num:Opt))
(cond
((eq (car OptElev) (caar Num:Opt))
(setq ThisList (cdr Num:Opt)) (eval f5)
)
( T (setq ThisList (vl-remove OptElev Num:Opt))(eval f5)
(princ (strcat "\nMoving Option | " (Car OptElev) ":" (Cadr OptElev)))
(foreach opt_ (caddr OptElev)
(and (setq from (caddr (assoc (strcat (Car OptElev) opt_) Num)))
(setq tpoint (caddr (assoc (strcat (caar Num:Opt) opt_) Num)))
(_DelMoveWindow from (list (Car from) (Car tpoint)))
)
)
)
)
)
)
(princ)
)
(vl-load-com)
Watch the video to see how it works
Type a product name
May we collect and use your data?
Learn more about the Third Party Services we use and our Privacy Statement. May we collect and use your data to tailor your experience?
Explore the benefits of a customized experience by managing your privacy settings for this site or visit our Privacy Statement to learn more about your options.
