(defun c:BindFix15
;//////////////////////////////////////////////////////////////////////
;
; BindFix15.lsp (AutoCAD 2000+)
;
; Copyright 2003 · Michael Puckett · All Rights Reserved
;
; Ver 1.01 2004/04/23 fixed:
;
; __RenameTableEntry had superfluous local decl. 'data'.
; __RenameTableEntryViaActiveX had superfluous local decl. 'data'
; __StripBindingArtifacts missing local decl. 'ceiling'.
; __GetUniqueTableEntryName missing local decl. 'i'.
;
;//////////////////////////////////////////////////////////////////////
( /
; local defuns
__GetTableEntries
__RenameTableEntry
__RenameTableEntryViaObjname
__RenameTableEntryViaActiveX
__StripBindingArtifacts
__GetUniqueTableEntryName
; local vars
doc
newname
)
;//////////////////////////////////////////////////////////////////////
;
; local defun __GetTableEntries
;
;//////////////////////////////////////////////////////////////////////
(defun __GetTableEntries ( table / data result )
(while (setq data (tblnext table (null data)))
(setq result
(cons (cdr (assoc 2 data)) result)
)
)
result
)
;//////////////////////////////////////////////////////////////////////
;
; local defun __RenameTableEntry
;
;//////////////////////////////////////////////////////////////////////
(defun __RenameTableEntry ( doc table oldname newname )
; wrapper for __RenameTableEntryViaObjname
; and __RenameTableEntryViaActiveX functions
(setq table
(cond
((eq (setq table (strcase table t)) "ltype") "linetype")
(t table)
)
)
(if (member table '("style" "dimstyle"))
; autodesk made textstyles and dimstyles read-only to
; the automation model w/regards to the symbol name, why?
(__RenameTableEntryViaObjname table oldname newname)
(__RenameTableEntryViaActiveX doc table oldname newname)
)
)
;//////////////////////////////////////////////////////////////////////
;
; local defun __RenameTableEntryViaObjname
;
;//////////////////////////////////////////////////////////////////////
(defun __RenameTableEntryViaObjname ( table oldname newname / data )
; calling function responsible for
; ensuring appropriate data passed
(entmod
(subst
(cons 2 newname)
(assoc 2 (setq data (entget (tblobjname table oldname))))
data
)
)
)
;//////////////////////////////////////////////////////////////////////
;
; local defun __RenameTableEntryViaActiveX
;
;//////////////////////////////////////////////////////////////////////
(defun __RenameTableEntryViaActiveX ( doc table oldname newname )
; calling function responsible for
; ensuring appropriate data passed
(vla-put-name
(vla-item
(eval
(list
(read (strcat "vla-get-" table "s"))
doc
)
)
oldname
)
newname
)
; if you wanted this to be more robust
; you could use the following ...
;
; (vl-catch-all-apply
; (function
; (lambda ()
; (vla-put-name ...)
; )
; )
; )
;
; I chose to pass valid data instead
)
;//////////////////////////////////////////////////////////////////////
;
; local defun __StripBindingArtifacts
;
;//////////////////////////////////////////////////////////////////////
(defun __StripBindingArtifacts ( entry / i done ceiling )
(cond
( (wcmatch entry "*`$#`$*")
(setq i 0 ceiling (strlen entry))
(while (and (not done) (< i ceiling))
(if (wcmatch (substr entry (setq i (1+ i)) 3) "`$#`$*")
(setq
entry (substr entry (+ i 3))
done t
)
)
)
)
)
entry
)
;//////////////////////////////////////////////////////////////////////
;
; local defun __GetUniqueTableEntryName
;
;//////////////////////////////////////////////////////////////////////
(defun __GetUniqueTableEntryName ( table entry / i )
(cond
( (tblsearch table entry)
(setq i 1)
(while
(tblsearch table
(strcat entry "_" (itoa (setq i (1+ i))))
)
)
(strcat entry "_" (itoa i))
)
( t entry )
)
)
;//////////////////////////////////////////////////////////////////////
;
; "main"
;
;//////////////////////////////////////////////////////////////////////
(cond
( (< 14 (atoi (getvar "acadver")))
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(foreach table '("block" "dimstyle" "layer" "ltype" "style")
(foreach entry (reverse (__GetTableEntries table))
(cond
( (wcmatch entry "*`$#`$*")
(__RenameTableEntry
doc
table
entry
(setq newname
(__GetUniqueTableEntryName table
(__StripBindingArtifacts entry)
)
)
)
(princ
(strcat "\n"
(if (tblsearch table newname)
(strcat
"Renamed "
table " "
entry " => "
newname "."
)
(strcat
"Could not rename "
table " "
entry "."
)
)
)
)
)
)
)
)
)
( t (princ "\nSorry, penned for AutoCAD 2000+."))
)
(princ)
)
