(DEFUN c:sellayers (/ theselset cnt) (SETQ doneblocklist NIL) (SETQ theselset (SSGET)) (IF theselset (PROGN (SETQ cnt 0 thesellayers NIL theblocklayers NIL selusedlayers NIL sort-selusedlayers NIL ) ;_ end of setq (REPEAT (SSLENGTH theselset) (SETQ thisename (SSNAME theselset cnt)) (COND ((EQ (CDR (ASSOC 0 (ENTGET thisename))) "INSERT") (IF (AND thesellayers (MEMBER (STRCASE (CDR (ASSOC 8 (ENTGET thisename)))) thesellayers)) NIL (SETQ thesellayers (APPEND thesellayers (LIST (STRCASE (CDR (ASSOC 8 (ENTGET thisename))))))) ) (getblocklayers thisename) ) (T (IF (AND thesellayers (MEMBER (STRCASE (CDR (ASSOC 8 (ENTGET thisename)))) thesellayers)) NIL (SETQ thesellayers (APPEND thesellayers (LIST (STRCASE (CDR (ASSOC 8 (ENTGET thisename))))))) ) ;_ end of if ) ) ;_ end of COND (SETQ cnt (1+ cnt)) ) ;_ end of repeat (FOREACH n thesellayers (IF (AND selusedlayers (MEMBER n selusedlayers)) NIL (SETQ selusedlayers (APPEND selusedlayers (LIST n))) ) ) (FOREACH n theblocklayers (IF (AND selusedlayers (MEMBER n selusedlayers)) NIL (SETQ selusedlayers (APPEND selusedlayers (LIST n))) ) ) (SETQ sort-selusedlayers (ACAD_STRLSORT selusedlayers)) (IF sort-selusedlayers (PROGN (PRINC "\nSorted layers used: ") (FOREACH n sort-selusedlayers (PRINC "\n\t\t") (PRINC n) (PRINC)) ) ;_ end of progn (PROGN (PRINC "\nUnsorted layers used: ") (FOREACH n selusedlayers (PRINC "\n\t\t") (PRINC n) (PRINC)) ) ;_ end of progn ) ;_ end of if ) ;_ end of progn ) ;_ end of if (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN C:ALLUSEDON (/ selusedstr quit-allusedon) (IF selusedlayers (PROGN (PRINC "\nPrevious Selection \"Used Layer List\":") (FOREACH n selusedlayers (PRINC "\n\t") (PRINC n) (PRINC)) (SETQ do-prev-used (ukword 1 "Any Exactly Reselect Quit Skip" "eselect, use previous list xactly, match to ny xref, kip, or uit?" (IF do-prev-used do-prev-used "Reselect" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (COND ((EQ do-prev-used "Any") (SETQ selusedlayers (MAPCAR '(LAMBDA (x) (IF (WCMATCH x "0,DEFPOINTS") x (STRCAT "*|" (IF (WCMATCH x "*|*") (WHILE (WCMATCH x "*|*") (SETQ x (SUBSTR x 2))) x ) ;_ end of IF ) ;_ end of STRCAT ) ;_ end of IF ) ;_ end of lambda selusedlayers ) ;_ end of mapcar ) ;_ end of setq ) ((EQ do-prev-used "Reselect") (c:sellayers)) ((EQ do-prev-used "Exactly") NIL) ((OR (EQ do-prev-used "Quit") (NOT do-prev-used)) (SETQ quit-allusedon T)) ((EQ do-prev-used "Skip")(c:sellayers)) ) ;_ end of COND ) ;_ end of PROGN (c:sellayers) ;if previous selection does not exist get the selection ) ;_ end of IF (IF quit-allusedon NIL (PROGN (IF selusedlayers (SETQ selusedstr (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (STRCAT x (IF (EQ x (LAST selusedlayers)) "" "," ) ;_ end of IF ) ;_ end of STRCAT ) ;_ end of LAMBDA selusedlayers ) ;_ end of MAPCAR ) ;_ end of CONS ) ;_ end of EVAL ) ;_ end of SETQ ) ;_ end of IF (IF selusedstr (PROGN (COMMAND ".layer" "t" selusedstr "") (COMMAND ".layer" "on" selusedstr "") (IF (EQ (GETVAR "TILEMODE") 1) NIL (COMMAND ".vplayer" "t" selusedstr "c" "") ) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN getblocklayers (thisename /) (IF (MEMBER (STRCASE (CDR (ASSOC 2 (ENTGET thisename)))) doneblocklist) (IF (ENTNEXT thisename) (SETQ thisentdef (ENTGET (ENTNEXT thisename))) (SETQ thisentdef NIL) ) ;_ end of IF (PROGN (SETQ doneblocklist (APPEND doneblocklist (LIST (STRCASE (CDR (ASSOC 2 (ENTGET thisename))))))) (SETQ thisentdef (ENTGET (TBLOBJNAME "block" (CDR (ASSOC 2 (ENTGET thisename)))))) (SETQ resumeentdef thisentdef) (WHILE (AND thisentdef (ENTNEXT (CDR (ASSOC -1 thisentdef))) (NOT (EQ (CDR (ASSOC 0 thisentdef)) "ENDBLK")) ) (IF (MEMBER (STRCASE (CDR (ASSOC 8 thisentdef))) theblocklayers) NIL (SETQ theblocklayers (APPEND theblocklayers (LIST (STRCASE (CDR (ASSOC 8 thisentdef)))))) ) (IF (EQ (CDR (ASSOC 0 thisentdef)) "INSERT") (IF (AND thisinsertlist (MEMBER (STRCASE (CDR (ASSOC 2 thisentdef))) thisinsertlist)) NIL (SETQ thisinsertlist (APPEND thisinsertlist (LIST (STRCASE (CDR (ASSOC 2 thisentdef)))))) ) ) (SETQ thisentdef (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef))))) ) (SETQ thisentdef resumeentdef) (WHILE (AND thisentdef (ENTNEXT (CDR (ASSOC -1 thisentdef))) (NOT (EQ (CDR (ASSOC 0 thisentdef)) "ENDBLK")) ) ;_ end of AND ;;; (PRINC "\n\t\t\t") ;;; (PRINC (CDR (ASSOC 0 thisentdef))) ;;; (PRINC ": ") ;;; (PRINC (CDR (ASSOC 8 thisentdef))) ;;; (PRINC) (SETQ theblocklayers (APPEND theblocklayers (LIST (STRCASE (CDR (ASSOC 8 thisentdef)))))) (COND ((AND (EQ (CDR (ASSOC 0 (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef)))))) "INSERT") (MEMBER (STRCASE (CDR (ASSOC 2 (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef))))))) doneblocklist) ) (IF (MEMBER (STRCASE (CDR (ASSOC 8 (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef))))))) theblocklayers) NIL (SETQ theblocklayers (APPEND theblocklayers (LIST (STRCASE (CDR (ASSOC 8 (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef)))))))))) ) (IF (ENTNEXT (ENTNEXT (CDR (ASSOC -1 thisentdef)))) (SETQ thisentdef (ENTGET (ENTNEXT (ENTNEXT (CDR (ASSOC -1 thisentdef)))))) (SETQ thisentdef NIL) )) ((EQ (CDR (ASSOC 0 (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef)))))) "INSERT") (IF (MEMBER (STRCASE (CDR (ASSOC 8 (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef))))))) theblocklayers) NIL (SETQ theblocklayers (APPEND theblocklayers (LIST (STRCASE (CDR (ASSOC 8 (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef)))))))))) ) (getblocklayers (ENTNEXT (CDR (ASSOC -1 thisentdef)))) ) (T (IF (AND thesellayers (MEMBER (STRCASE (CDR (ASSOC 8 (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef))))))) thesellayers) ) ;_ end of AND NIL (SETQ thesellayers (APPEND thesellayers (LIST (STRCASE (CDR (ASSOC 8 (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef)))))))) ) ;_ end of APPEND ) ;_ end of SETQ ) ;_ end of if ) ) ;_ end of COND (IF (AND thisentdef (ENTNEXT (CDR (ASSOC -1 thisentdef)))) (SETQ thisentdef (ENTGET (ENTNEXT (CDR (ASSOC -1 thisentdef))))) (SETQ thisentdef NIL) ) ;_ end of IF ) ;_ end of while ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of defun ;;;**************************************************************************** (DEFUN entityis (entdef /) (PRINC "\nEntity is: ") (PRINC (CDR (ASSOC 0 entdef))) (PRINC)) ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T) ;*** DO NOT add text below the comment! ***|;