我刚刚将一个VBA项目文件“TextFind&Replace.dvb”放在池塘中，允许您选择在哪个目录中查找图形，选择要搜索的图形，搜索短语和替换内容
此时，它不会列出找到文本并修改的图形，但添加该功能也不会太难。这是一项正在进行的工作，基于CADVault.com上的代码。事实上，整个文件夹/文件浏览都是从那里开始的代码
欢迎反馈，并将产生更为完美的最终产品
哦，2004年之前的ACAD用户必须确保该对象。DBX可以使用。如果不确定，请运行此小代码段以确定。
(if (and (= (atoi (getvar "AcadVer")) 15)
(not (vl-registry-read "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"))
)
(startapp "regsvr32.exe" (strcat "/s \"" (findfile "axdb15.dll") "\""))
)
杰夫 Jeff
它在这里停止
Dim bolMod 作为布尔值： bolMod = false
编译错误
无效 外部过程 对不起，CAB-
我在测试后将一条应该拆分的线移动到公共区域。如果您将代码编辑为此，它将起作用。
Dim strNew As String
Dim bolMod As Boolean 'EDIT this line
Private Sub UserForm_Initialize()
'Set up
Set objDbx = GetInterfaceObject("ObjectDBX.AxDbDocument")
Me.Caption = "Object DBX Batch Process"
ListBox1.MultiSelect = fmMultiSelectMulti
CommandButton1.Caption = "Browse for folder"
CommandButton2.Caption = "Process Selection"
CommandButton3.Caption = "Exit"
bolMod = False 'ADD this line
End Sub
CAB，
这是一个通过 vlisp 的 ObjectDBX 方法。 尝试一下，让我知道它如何为你服务。
(vl-load-com)
(defun *error* (msg)
(princ "\nError: ")
(princ msg)
(princ)
(if (and dbxdoc (not (vlax-object-released-p dbxdoc)))
(vlax-release-object dbxdoc)
)
(gc)
(princ)
)
(defun DLLRegister (dll)
(startapp "regsvr32.exe" (strcat "/s \"" dll "\""))
)
(defun ProgID->ClassID (ProgID)
(vl-registry-read
(strcat "HKEY_CLASSES_ROOT\\" progid "\\CLSID")
)
)
(defun DBX-Register (/)
(if (/= (getvar "ACADVER") "15.0")
(setq classname "ObjectDBX.AxDbDocument.16")
(setq classname "ObjectDBX.AxDbDocument")
)
(cond
((ProgID->ClassID classname))
((and
(setq server (findfile "AxDb15.dll"))
(DLLRegister server)
(ProgID->ClassID classname)
)
(ProgID->ClassID classname)
)
((not (setq server (findfile "AxDb15.dll")))
(alert
"Error: Cannot locate ObjectDBX Type Library (AxDb15.dll)..."
)
)
(T
(DLLRegister "ObjectDBX.AxDbDocument")
(or
(ProgID->ClassID "ObjectDBX.AxDbDocument")
(alert
"Error: Failed to register ObjectDBX ActiveX services..."
)
)
)
)
)
(defun findphrase (phrase document / count)
(setq count 0)
(vlax-for item (vla-get-modelspace document)
(cond ((or (eq (vla-get-ObjectName item) "AcDbText")
(eq (vla-get-ObjectName item) "AcDbMText")
)
(if (vl-string-search phrase (vla-get-textstring item))
(setq count (1+ count))
)
)
((and (eq (vla-get-Objectname item) "AcDbBlockReference")
(eq (vla-get-hasattributes item) :vlax-true)
)
(foreach for-item (get_atts item)
(if (vl-string-search phrase (vla-get-textstring for-item))
(setq count (1+ count))
)
)
)
)
)
count
)
(defun get_atts (obj)
(vlax-safearray->list
(vlax-variant-value
(vla-getattributes obj)
)
)
)
(defun c:tfar (/ file files str dbxdoc of lst wil classname)
(setq file "")
(while (setq file (getfiled "Select a file to replace text in" file "dwg" 128))
(setq files (cons file files))
)
(cond ((not files) (princ "No files were selected."))
((not (setq str (getstring T "Enter search phrase?")))
(princ "\nSearch phrase is missing. ")
)
((not (DBX-Register)) (princ "Unable to load ObjectDBX."))
((not (setq dbxdoc (vla-GetInterfaceObject
(vlax-get-acad-object)
classname
)
)
)
(princ "Unable to load ObjectDBX.")
)
(T
(foreach f (reverse files)
(setq of(vl-catch-all-apply
'(lambda ()
(vlax-invoke-method dbxdoc 'open f)
)
)
lst (if (vl-catch-all-error-p of)
(list f "File was read only. ")
(list f (findphrase str dbxdoc))
)
wil (cons lst wil)
)
)
)
)
(if (and dbxdoc (not (vlax-object-released-p dbxdoc)))
(vlax-release-object dbxdoc)
)
(gc)
(textscr)
(mapcar '(lambda (x)
(princ
(strcat "\n"
(car x)
"\n"
(cond ((eq (type (cadr x)) 'INT)
(strcat (itoa (cadr x))
" text entities matched your phrase."
)
)
(T (cadr x))
)
)
)
)
wil
)
(princ)
)
页:
1
[2]