(defun c:$ ()
(setq dwgn (getvar "dwgname"))
(setq dwgpass (getvar "dwgprefix"))
(setq fname (strcat dwgpass dwgn "-$" ".txt"))
(l$)
(ren$)
; (alert "Blocks, Layers, Dimstyles & Styles containing $ are renamed")
)

;**************************************************************************
;**************************************************************************
(defun l$ ()
(setq lafile (open fname "w"))
;**************
(setq record (tblnext "block" T))
(while record
(setq blkname (cdr(assoc 2 record)))
(if (= (wcmatch blkname "?,*$*,?") t)
(if (/= "*" (substr blkname 1 1))
(progn
(princ (strcat "bl " blkname) lafile)
(princ "\n" lafile)
)
)
)
(setq record (tblnext "block"))
)
;**************
(setq record (tblnext "layer" T))
(while record
(setq lname (cdr(assoc 2 record)))
(if (/= lname "0")
(if (= (wcmatch lname "?,*$*,?") t)
(if (/= "*" (substr lname 1 1))
(progn
(princ (strcat "la " lname) lafile)
(princ "\n" lafile)
)
)
)
)
(setq record (tblnext "layer"))
)
;******************
(setq record (tblnext "dimstyle" T))
(while record
(setq dname (cdr(assoc 2 record)))
(if (= (wcmatch dname "?,*$*,?") t)
(if (/= "*" (substr dname 1 1))
(progn
(princ (strcat "di " dname) lafile)
(princ "\n" lafile)
)
)
)
(setq record (tblnext "dimstyle"))
)
;******************
(setq record (tblnext "style" T))
(while record
(setq sname (cdr(assoc 2 record)))
(if (= (wcmatch sname "?,*$*,?") t)
(if (/= "*" (substr sname 1 1))
(progn
(princ (strcat "st " sname) lafile)
(princ "\n" lafile)
)
)
)
(setq record (tblnext "style"))

)
;******************
(setq record (tblnext "LTYPE" T))
(while record
(setq LTname (cdr(assoc 2 record)))
(if (= (wcmatch LTname "?,*$*,?") t)
(if (/= "*" (substr LTname 1 1))
(progn
(princ (strcat "LT " LTname) lafile)
(princ "\n" lafile)
)
)
)
(setq record (tblnext "LTYPE"))

)
;******************

(close lafile)
)
;**************************************************************************
;**************************************************************************
(defun ren$ ()
(setq f fname)
(setq f (open f "r"))
(setq ctr 1)
(while
(setq rline (read-line f))
(setq ntype (substr rline 1 2))
(setq oname (substr rline 4 100))
(setq nname (strcat "x-" (itoa ctr)))
(if (= ntype "bl")
(command "rename" "bl" oname nname)
)
(if (= ntype "st")
(command "rename" "st" oname nname)
)
(if (= ntype "la")
(command "rename" "la" oname nname)
)
(if (= ntype "di")
(command "rename" "di" oname nname)
)
(if (= ntype "LT")
(command "rename" "LT" oname nname)
)

;(princ bname)
(setq ctr (+ ctr 1))
)
)
;**************************************************************************
;**************************************************************************
(c:$)

Advertisements