CAD 之VBA 问答

win0757

在调用一个交互式对话框之后生成VBA执行代码
问题：
如果需用VBA宏来启动一个AutoCAD交互式（内置）对话框，在VBA宏没有执行完之前AutoCAD将不会打开这个对话框。（直到VBA宏执行完以后，使用ThisDrawing.SendCommand方法执行的AutoLISP命令才被排到AutoCAD的队列中。
这将导致用户不能运行代码，或不能做修改，或不能检查各参数的选择。



解决方法：
如果将宏分成两部分或更多部分，用这种排队方法可以带来很多好处，可以强制这些宏继续工作——实际上，当对话框关闭时第二个宏承担控制工作。
在下面的例子中，对话框关闭以后，宏调用第二“部分”。
Sub Test()
Sub Test()  
  MsgBox "Please setup the layout the way you would like", vbOkOnly, "User Prompt"  
  ' This command queues the launch of the 'Layout Wizard' dialog
  ThisDrawing.SendCommand ("(command ""_layoutwizard"")" & vbCr)  
  ' This command queues the second part of the macro  
  ThisDrawing.SendCommand ("(command ""_-vbarun"" ""Test_Part_2"")" & vbCr)  
End Sub  
Sub Test_Part_2()  
  MsgBox "Part 2"  
End Sub

win0757

一个关于变体型数组(Variant Array)的常见VBA问题


问：我想对一个圆弧进行操作。但是当我运行下面的VBA宏时，出现一个编号为451的运行错误。它的意思是‘对象不是一个集合’。这是一个关于变体型数组(Variant Array)的常见VBA问题吗？有什么方法可以解决？
Sub showArcPoints()
    Dim oEnt As Object
    For Each oEnt In ThisDrawing.ModelSpace
        If (TypeOf oEnt Is AcadArc) Then
            ' This causes Runtime error 451 - Object Not a Collection
            ' if oEnt is not late bound it works ok
            MsgBox "StartPoint(0) is =" & oEnt.StartPoint(0)
        End If
    Next
End Sub



答：当VBA从一个一般对象返回变体型数组的时候，如果这个对象是晚束缚（late bound）的话，VBA不能通过这个对象的属性返回数组的一个元素。如果这个对象是早束缚（early bound）的话，那么就不受限制。
有两种办法可以解决这个问题。其一、用AcadArc 来对此对象进行早束缚。修改好的代码如下：
Sub showArcPoints()
    Dim oEnt As Object
    Dim oArc As AcadArc
    For Each oEnt In ThisDrawing.ModelSpace
        If (TypeOf oEnt Is AcadArc) Then
            'This works well since it is early bound.
            Set oArc = oEnt
            MsgBox "StartPoint(0) = " & oArc.StartPoint(0)
        End If
    Next
End Sub
其二、声明一个临时的变体型变量并且把它设置为需要操作的对象属性。修改的代码如下：
Sub showArcPoints()
    Dim oEnt As Object
    For Each oEnt In ThisDrawing.ModelSpace
        If (TypeOf oEnt Is AcadArc) Then
            'This also works well.
            Dim pv_temp As Variant
            pv_temp = oEnt.StartPoint
            MsgBox "StartPoint(0) = " & pv_temp(0)
        End If
    Next
End Sub

win0757

有什么方法可以检测一个VBA宏是否加载？



在AutoCAD 2000中，你可以获取一个属性名叫VBE的ActiveX应用程序对象。它使你可以访问VBAIDE扩展对象。这个对象拥有方法和属性允许你判断一个工程是否已经加载。
    如果你想深入学习，就请启动VBAIDE，添加一个对"Microsoft Visual Basic for Applications Extensibility"的引用，然后你就可以在你的ObjectBrowser (F2)浏览此对象了。
以下是四个例子。第一个"loadMyProcedure"检测所有已经加载的工程名。如果没有发现"TestMenuEcho"，就加载它。
    第二个例子"testMacros"在每一个加载的模块中搜索每一行并且在立即窗口中 (cntrl + G)打印true或者false。目的在于寻找文本"test4"（宏的名字)。
    第三个例子"displayLoadedProjects"在信息窗口中显示所有已加载的工程。
    第四个例子是一个LISP例程。它使用相同的ActiveX对象判断一个工程是否已经加载，如果没有，就加载它。

Public Sub loadMyProcedure()
Dim int1 As Integer
Dim bProjectLoaded As Boolean
' Iterate through all the projects
For int1 = 1 To Application.VBE.VBProjects.Count
     ' Make the test boolean variable to true if the Project I want to load
     ' is already loaded, Change TestMenuEcho to the name of your project
     If Application.VBE.VBProjects(int1).Name = "TestMenuEcho" Then
        ' Debug.Print Application.VBE.VBProjects(int1).Name
         bProjectLoaded = True
     End If
Next int1
' Display a message if my the project is already loaded
' if it isn't then load it, change the directory and
' name to that of your project
If bProjectLoaded = True Then
     MsgBox "TestMenuEcho is already loaded"
Else
     MsgBox "Going to load the project TestMenuEcho"
     Application.LoadDVB "D:\Vba-apps\a-2000\menuecho in menu.dvb"
End If
End Sub
Public Sub testMacros()
Dim int1 As Integer
Dim int2 As Integer
' Iterate through all the loaded projects
For int1 = 1 To Application.VBE.VBProjects.Count
     ' Name of loaded project
     Debug.Print Application.VBE.VBProjects(int1).Name
     ' Iterate through the text of each module looking for "test4"
     For int2 = 1 To Application.VBE.VBProjects(int1).VBComponents.Count
         ' Get the number of lines in each module - use in the
         ' find method below
         Dim L As Long
         L = Application.VBE.VBProjects(int1).VBComponents(int2) _
         .CodeModule.CountOfLines
         Debug.Print Application.VBE.VBProjects(int1).VBComponents(int2) _
         .CodeModule.Find("test4", 1, 1, L, 1, False, False)
     Next int2
Next int1
End Sub
Public Sub displayLoadedProjects()
Dim strProjectNames
Dim int1 As Integer
strProjectNames = "Names of loaded projects " & vbCrLf
For int1 = 1 To Application.VBE.VBProjects.Count
   strProjectNames = strProjectNames + Application.VBE.VBProjects(int1).Name & vbCrLf
Next int1
MsgBox strProjectNames
End Sub
(defun c:loadMyProject ()
;; This routine will load a project if it is not already loaded
;; the VBE (VB extensibility) ActiveX object is used to reference
;; the loaded projects
;; Load ActiveX  
(vl-load-com)
;; Get the VBE extisibility object  
(setq acadObject (vlax-get-acad-object))
(setq acadVbe (vla-get-vbe acadObject))
(setq acadVbeProjects (vlax-get-property acadVbe 'VBProjects))
;; Get the number of loaded VBA projects
(setq int1 (vlax-get-property acadVbeProjects 'count))
;; Counter and test variable named loaded  
(setq int2 1)
(setq loaded "False")
;; Repeat for each project  
(repeat int1
;; Itereate through the projects, getting the name of
;; next project, each time through  
(setq Item (vlax-invoke-method acadVbeProjects 'Item int2))
(setq pName (vlax-get-property Item 'Name))
  
;; Test the name for the name of the project I want to load
;; If it is already loaded the set the test variable to True
(if (= pName "my_test_project")
  (progn
     (prompt "\nmy_test_project is already loaded\n")
     (Setq Loaded "True")
  )
)
;; Increment the number used to get the next Project
(setq int2 (+ int2 1))
)
;; Load project if it is not already loaded by testing
;; the Loaded variable
(if (= Loaded "False")
(progn
  (princ "\nLoading my_test_project")
  (command "-VBALOAD"
            "D:/vba-apps/a-2000/already loaded test.dvb"
  )
)

win0757

怎样检查图形文件锁定状态？


因为我们现在使用了操作系统支持的文件锁定方式，你可以通过用_fsopen()打开图形文件来检查文件是否锁定。使用模式"r+"和共享标志SH_DENYWR，如果失败，这个图形就已经被打开并且是写的状态。如果成功，千万不要忘记关闭此文件，然后再让AutoCAD打开它。
    同时你也需要检查.DWK文件，因为这个文件也可能被另外的R13例程所打开。
2) 用LISP运行一些VBA代码打开这个文件，通过一个系统变量返回一个成功或者失败标志给LISP。例如：下面的VBA代码可以做这件事情。
Sub Test_File_Data()
Dim FileNum As Integer
Dim MyFileName As String
Dim sysVarName As String
Dim sysVarData As Variant
On Error GoTo ErrHandler
FileNum = 1
MyFileName = "D:\PROGRAM FILES\AUTOCAD R14\ARCTEXT.DWG"
sysVarName = "USERI1"
sysVarData = 0
ThisDrawing.SetVariable sysVarName, sysVarData
Open MyFileName For Binary Access Read Lock Read Write As FileNum
Close 1
sysVarData = 1
ThisDrawing.SetVariable sysVarName, sysVarData
Exit Sub
ErrHandler:
MsgBox "Error Number = " & Err.Number
MsgBox "Error Description = " & Err.Description
Err.Clear
sysVarData = 0
ThisDrawing.SetVariable sysVarName, sysVarData
End Sub

win0757

如何在AutoLISP调用完一个VBA宏后，卸载包含它的VBA工程？
问： 如何在AutoLISP调用完一个VBA宏后，卸载包含它的VBA工程？我想首先加载这个工程，调用一个宏，然后卸载它。下面是我使用的代码，但是VBAUNLOAD在Test宏结束之前被发送到命令行。
  (command "-VBARUN" "Test")
  (command "vbaunload")
答：主要的问题是你的宏当中有要求用户输入的语句，这时LISP试图执行下一条命令，即VBAUNLOAD。我们需要等待LISP语句执行完毕，或者让LISP在调用VBARUN命令后什么也不做，而让VBA卸载它自己。下面是这两种方法：
1) 在LISP中等待。
(defun c:RunMacro( / oldFileDia oldCmdEcho)
  (setq oldFileDia (getvar "FILEDIA")
         oldCmdEcho (getvar "CMDECHO")
  )
  (setvar "FILEDIA" 0)
  (setvar "CMDECHO" 0)
  (command "_VBALOAD" "c:\\test.dvb")
  (command "_-VBARUN" "Test")
  (while (= "-VBARUN" (getvar "CMDNAMES"))
        (command pause)
  )
  (command "_VBAUNLOAD")
  (setvar "FILEDIA" oldFileDia)
  (setvar "CMDECHO" oldCmdEcho)
  (princ)
)
2) VBA中自动卸载。
    你可以使VBA代码强制卸载它自己。在你的宏的最后（例如：UserForm_Terminate()），使用下列代码可以达到此目的：
   AppActivate ThisDrawing.Application.Caption
   SendKeys "_VBAUNLOAD" + Chr$(13)
    以上的代码在AutoCAD R14.01中工作良好，但是AutoCAD 2000允许加载多个工程。相应地，VBAUNLOAD增加了一个额外参数。有两个新的函数可以加载和运行VBA 代码：(vl-vbaload)和(vl-vbarun)。你可以通过在宏名中指定工程名字把这两种操作联合在一起。
(defun c:RunMacro2000( / oldFileDia oldCmdEcho)
  (setq oldFileDia (getvar "FILEDIA")
         oldCmdEcho (getvar "CMDECHO")
  )
  (setvar "FILEDIA" 0)
  (setvar "CMDECHO" 0)
  (vl-vbarun "c:\\test.dvb!Test")
  (while (= "-VBARUN" (getvar "CMDNAMES"))
        (command pause)
  )
  (command "VBAUNLOAD" "c:\\test.dvb")
  (setvar "FILEDIA" oldFileDia)
  (setvar "CMDECHO" oldCmdEcho)
  (princ)
)
    第二种方法也需要做一些小的改动。我们可以通过自动接口向AutoCAD发送命令，并且这比SendKeys更安全：
   ThisDrawing.SendCommand "_VBAUNLOAD C:\TEST.DVB" + Chr$(13)
    如果我们卸载另一个工程，我们可以使用自动接口 (ThisDrawing.Application.UnloadDVB "test.dvb" )。但是在这种情况下我们需要使用SendKeys或SendCommand来卸载其本身。
可以在VBA中获得带有预览图象的AutoCAD "打开文件"对话框吗？
在VBA没有直接的方法这样做。但是，你可以通过LISP和AutoCAD之间的通讯来完成。在LISP中有一个名叫getfiled的函数，它可以预览DWG并且与AutoCAD的"Open File Dialog"表现一样。
    首先，通过SendCommand方法发送getfiled表达式给AutoCAD命令行并且定义一个系统变量USERS1以保存文件名。然后，你可以用GetVariable方法获得这个系统变量。最后，象使用其它任何变量一样使用它。
Public Sub OpenDialog()
Dim fileName As String
ThisDrawing.SendCommand "(setvar " & """users1""" & "(getfiled " & """Select a DWG File""" & """c:/program files/acad2000/""" & """dwg""" & "8)) "
fileName = ThisDrawing.GetVariable("users1")
MsgBox "You have selected " & fileName & "!!!", , "File Message"

win0757

怎样用Visual Basic生成一个用户接口模块以供Visual LISP方便地调用？
最简单和最有效的方法是为AutoCAD写一个内过程(in-process)的自动客户(Automation Client)。例如：一个VB ActiveX DLL。这个DLL 以后可以从 Visual LISP, VBA, Java (通过Automation)和ObjectARX加载。它可以是一个AutoCAD的自动客户，也可以是一个任何的自动服务器( Automation server)，或者多重服务器。
1. 启动Visual Basic 5 or 6；
2. 在New Project Wizard中选择ActiveX DLL；
3. 把工程名改为"MyProject"；
4. 在工程中有一个缺省的类模块，把它的名称改为"MyClass"；
5. 添加一个函数或者子例程到类模块中。例如：
' This function takes two arguments, and will return a list of data to the calling function
Public Function MyFn(ByRef arg1 as Integer, ByRef arg2 as Double) As Variant
  myForm.Show vbModal
  ' Create a list of items to return to the caller (the items are in this case purely arbitrary)
  MyFn = Array(1.0,"Arbitrary string",2)
End Function
（这里，myForm是一个你必须添加到工程中的表格。同时切记MyFn是一个函数，它将返回一个值或者一组值给调用例程。）
6. 点取File -
Make MyProject.dll。这就会生成一个DLL并且把它注册为COM。（如果你想在其他机器上运行此DLL，你需要首先确认在所有的机器上安装并注册了这个DLL。这通常需要你用Visual Basic生成一个安装包。）
7. 如果你想从Visual LISP中使用此DLL,你需要定义一个简单的函数，并且把他加载到AutoCAD中：
(defun showDialog (/ acadApp vbApp retVal retList)
;; required in AutoCAD 2000, not R14
(if (car (atoms-family 1 '("vl-load-com"))) (vl-load-com))
;; get the main AutoCAD application object
(setq acadApp (vlax-get-acad-object))
;; load VB ActiveX DLL into AutoCAD's address space (either line will work)
;;(setq vbApp (vlax-invoke acadApp "GetInterfaceObject" "MyProject.MyClass")
(setq vbApp (vla-GetInterfaceObject acadApp "MyProject.MyClass"))
(if (not vbApp)
   (princ "\nError loading ActiveX DLL.")
   (vlax-invoke vbApp "MyFn"
                       7        ; arg1, an integer
                       1.5      ; arg2, a 'double'
   )
)
)
    为了调用已经暴露出的ActiveX方法，在命令行上输入：
(showDialog)
    将把下列内容返回给AutoCAD：
(1.0 "Arbitrary string" 2)
    你会发现你可以给VB对话框传递参数并且在AutoCAD中处理返回值。这对于生成选项对话框非常有用，因为有些参数需要初始化并且修改后的值需要返回给AutoCAD。
7. 如果你想从VBA使用这个DLL，你需要把此DLL添加到引用中。（用COM注册它，就会把它添加到ActiveX 服务器的列表中。然后它就可以被VBA引用，不然就请浏览并且选择MyProject.dll。）
8. 然后你就可以用下面的机制加载这个内过程 ActiveX DLL，并且调用其中的函数：
Sub MyVBAProject()
Dim oMyApp as Object
dim vReturn as Variant
set oMyApp = ThisDrawing.Application.GetInterfaceObject( "MyProject.MyClass"
)
vReturn = oMyApp.MyFn(7,1.5)
End Sub

win0757

能够给AutoCAD的VBA宏传递参数吗？
从AutoCAD直接传递参数到一个VBA宏中是不可能的。但是你可以用VBA的GetString方法和LISP的(command)函数来传递信息。
    举例：
    首先定义一个VBA宏：
Sub testparams()
   Dim str, str2 As String
   str=ThisDrawing.Utility.GetString(False)
   str2=ThisDrawing.Utility.GetString(False)
   MsgBox str
   MsgBox str2
End Sub
    然后用以下LISP语句调用此宏：
(command "-VBARUN" "testparams" "param1" "param2")

win0757

我不能在AutoCAD屏幕上点取一个点。我作错了什么？
问：我已经写了一个VBA例程用ThisDrawing.Utility.GetPoint获取一个点。当我从一个VBA对话框中启动这个例程时，我可以在命令行上看到提示。但是我不能在AutoCAD屏幕上点取一个点。我作错了什么？
答：首先需要关闭对话框，然后才能从AutoCAD获取数据。添加以下的代码到ThisDrawing.Utility.GetPoint之前的任何地方以关闭对话框，然后你就可以获得一个点了。
Me.Hide
我怎样从AutoCAD菜单中启动一个VBA对话框（窗体）？
除了创建一个VBA窗体，你还需要创建一个VBA子例程来显示这个窗体。而这个子例程需要用VBARUN命令激活。1. 启动VBA IDE；2. 从菜单中选择 插入 > 用户窗体（缺省名称为UserForm1）；3. 添加合适的控件到你的窗体中； 4. 下一步，从菜单中选择 插入 > 模块；5. 输入以下的代码到缺省的Module1模块中：Sub Foo() UserForm1.showEnd Sub6. 最后，编辑AutoCAD菜单调用以下命令来激活对话框： -VBARUN Module1.foo.

win0757

VBA和AutoLISP有何不同，两者如何转换？



如果你已经熟知AutoLISP并且想学习VBA，通过把VBA和AutoLISP表达式联系起来的方法就可以容易地做到。以下就是一个关于两种语言的比较。由于大量的AutoLISP代码可以利用，转换一个已有的AutoLISP代码段为VBA远比重新编制VBA代码来得容易。如果两者的变量名字保持一致，那么比较两者的代码也就变得容易了。
    在AutoLISP中，你用(setq)函数来设置一个点。下面这一行把点(0,0,0)分配给PT1变量。(0,0,0)代表这个点位置的x,y,z坐标。
(setq PT1 '(0 0 0))
    在VBA中，这个操作需要更多的代码行来完成：
Dim PT1(0 To 2) As Double
PT1(0) = 0#
PT1(1) = 0#
PT1(2) = 0#
    在VBA中，你使用Dim语句来声明变量。点总是保存在一个三维双精度值数组中。一个数组也就是一个变量列表。在数组中的变量都拥有相同的名字。数组中的第一个元素使用索引值0，即PT1(0)。第二个元素使用索引值1，即PT1(1)。依次类推。
    VBA使用#号作为双精度值类型的后缀字符。在这个数组中，PT1(0)保存x坐标值，PT1(1)保存y坐标值，PT1(2)保存z坐标值。
    既然你已经知道如何保存一个点，我们就可以写一个VBA宏来在两点之间画一条线。
    在AutoLISP中，你使用(defun)来定义一个名叫Line1的函数。在函数名字前的C: 意味着拥护可以直接从AutoCAD命令行上执行这个函数。下一步，分配两个点，然后用AutoCAD的LINE命令在两点之间画一条线了。
    在VBA中，一个子例程创建一个与AutoLISP相当的函数。下面是AutoLISP和VBA的源代码。
AutoLISP code
(defun C:LINE1 ()
  (setq PT1 '(0 0 0))
  (setq PT2 '(4 4 0))
  (command "._line" PT1 PT2 "")
)
VBA code
Sub Line1()
Dim NewLine As Object
Dim PT1(0 To 2) As Double
Dim PT2(0 To 2) As Double
PT1(0) = 0#
PT1(1) = 0#
PT1(2) = 0#
PT2(0) = 4#
PT2(1) = 4#
PT2(2) = 0#
Set NewLine = ModelSpace.AddLine(PT1, PT2)
End Sub
    子例程的第一行声明变量NewLine为一个对象。对象是一个应用程序的一个元素。线，视图和层都是对象的例子。下一步，点数组声明了两个点值。最后，AutoCAD从(0,0,0)到(4,4,0)画一条线。添加一条线到模型空间中，你需要使用ModelSpace对象集合中的AddLine方法和一条线的起始和终止点。
获取点：
用AutoLISP，你经常需要提示拥护选择一个点。你可以在VBA中用Utility对象的GetPoint方法达到这个目的。你需要声明一个额外的VarRet变量来保存返回值。以下是Line2的AutoLISP和VBA的代码对照：
AutoLISP code
(defun C:LINE2 ()
(setq PT1 (getpoint "\nStart Point: "))
(setq PT2 (getpoint PT1 "\nEnd Point: "))
(command "._line" PT1 PT2 "")
)
VBA code
Sub Line2()
Dim VarRet As Variant
Dim NewLine As Object
Dim PT1(0 To 2) As Double
Dim PT2(0 To 2) As Double
VarRet = Utility.GetPoint(, "Start Point: ")
PT1(0) = VarRet(0)
PT1(1) = VarRet(1)
PT1(2) = VarRet(2)
VarRet = Utility.GetPoint(PT1, "End Point: ")
PT2(0) = VarRet(0)
PT2(1) = VarRet(1)
PT2(2) = VarRet(2)
Set NewLine = ModelSpace.AddLine(PT1, PT2)
End Sub
    这一次，GetPoint方法返回一个Variant数据类型。这种数据类型可以保存任何类型的数据。为了使用你选择的并且保存在变量VarRet之中的开始和终止点，你必须转换Variant数据为一个双精度值的数组并且把他们付值给PT1和PT2。
    现在两个VBA子例程已经建立起来了，如何运行它们呢？
1.启动AutoCAD，打开一个新图；
2.加载工程；
3.选择 工具|宏|运行宏；
4.选择宏位置（缺省为所有活动图形和工程）；
5.从窗口中选择宏名称；
6. 点击运行按钮

win0757

在VBA中如何在命令行上提示？
有一些方法允许在命令行提示输入以获取数据。这些方法以“GET”开头。你可以发现决大多数的方法（如果不是全部的话）通过对象浏览器搜索AutoCAD类型库。 启动VBA IDE。击F2功能键或者从视图菜单中选择对象浏览器。在对象浏览器窗口中使用库范围下拉列表把缺省的<所有库>改成AutoCAD。库列表下面的编辑列表框是用来搜索的。输入GET到那个编辑列表框中并且敲回车键。包含“GET”的类和成员函数就会显示在滚动列表中。AcadUtility的一些成员函数可以在命令行上提示用户输入。
有办法可以在AutoCAD启动时自动运行一个VBA例程或宏吗？
当然。你可以从AutoCAD的acad.lsp文件的启动功能中通过VBARUN的命令行版本运行一个工程中的宏。首先，你需要准备acad.dvb文件以便自动加载。以drawline.dvb作为例子，用VBALOAD命令弹出VBA IDE对话框。然后用VBA IDE保存为菜单命令保存此工程为新的名字acad.dvb。下一步，激活notepad.exe并且建立或添加下列行到acad.lsp文件中：
(defun S::STARTUP() (command "_-vbarun" "drawline"))

当VBA加载时会在AutoCAD目录下寻找一个名叫acad.dvb的工程。如果找到，就会自动加载它。如果你想VBA和缺省工程在AutoCAD启动的时候每次都加载，你需要在acad.rx文件中生成一个入口。VBA被设计成命令加载方式（在没有激活一个VBA命令之前不占用任何内存和进程）。为了总是加载VBA和acad.dvb工程，请在acad.rx文件中包含下列一行：
acadvba.arx
    在AutoCAD 2000中支持嵌入工程，这样当你打开拥有嵌入工程的图形文件时该工程就会自动加载。所以定义嵌入工程也是一个很好的自动加载VBA工程的办法。

win0757

你想使用VBA编辑对象数据库链接的属性
使用连接自动控制对象(CAO) API来编辑对象数据库链接的属性。以下示例演示了怎样编辑链接的键值。

Sub f_editLinks()
'声明
Dim po_dbc As DbConnect
Dim po_lpn As CAO.LinkTemplate
Dim po_link As CAO.Link
Dim po_links As CAO.links
Dim po_keyVs As CAO.KeyValues
Dim po_keyV As CAO.KeyValue
'开始数据库连接
Set po_dbc = ThisDrawing.Application.GetInterfaceObject("CAO.Dbconnect")
'获取第一个链接模板。确认你至少有一个链接模板
Set po_lpn = po_dbc.GetLinkTemplates(ThisDrawing).Item(0)
'获取和链接模板关联的链接。
'你也可提供对象ID数组来获得和对象关联的链接
Set po_links = po_dbc.GetLinks(po_lpn)
'获取第一个链接
Set po_link = po_links(0)
Set po_keyVs = po_link.KeyValues
'获得第一个键值。
'记住它可以有多个键值
Set po_keyV = po_keyVs(0)
'更改键值的值。假定键值为数字的
po_keyV.Value = 1234
po_link.Update
End Sub

win0757

当使用VBA时你想控制作为实数返回的值的格式和精度


缺省状态时，VBA使用14位小数的形式返回和显示实数。你可更改返回实数的值的格式和精度。例如，你可选择格式为小数或科学计数，同时你可减少显示的十进制精度。这些解决方法可用于文本框和列表框对象，它是在Visual Basic中显示信息的最常用方法。

要控制返回实数的值的格式和精度，你使用RealToString的Visual Basic方法来转换数值。例如：
RetVal = RealToString(Value, Unit, Precision)
以下表格描述了表达式中的第一部分：
RetVal  值为要返回格式的字符串。
RealToString  方法。转换实数(双精度)值为字符串。
Value  要转换的值。
Unit  以下单位的类型：
acDefaultUnits  
acScientific  
acDecimal  
acEngineering  
acArchitectural  
acFractional  
Precision 值的精度。0-8之间的整数。
以下代码示范怎样使用Visual Basic来找到、格式化和显示系统变量TDINDWG(图形累计编辑时间)的值：
Dim varData As Double
Dim hours As Double
Dim hours_display As String
sysVarName = "TDINDWG"
' 取得变量值
varData = ThisDrawing.GetVariable(sysVarName)
' 转换值为小时
hours = varData * 24
' 转换过程
hours_display = ThisDrawing.Utility.RealToString(hours, acDecimal, 4)
' 在列表框中显示小时
ListBox1.AddItem hours_display & " 小时"

win0757

用VBA对图形进行改动后为什么无法即时显示出来
在VBA中所做的一些动作在每次操作后不能刷新显示。这种行为可以在对复杂图形的操作中节省很多的时间。在VBA中，编程都可指定什么时候对显示进行刷新。要刷新显示，可使用Update或Regen方法。Update方法用于对个别对象，而Regen方法用于整个图形。
用VBA创建DWF文件
你可使用VBA来自动创建DWF文件。以下代码示范了怎样用VBA创建DWF文件。
Sub test()
Dim objDoc As AutoCAD.AcadDocument
Set objDoc = Documents.Open("sample\colorwh.dwg")
Set objPlot = objDoc.Plot
Dim blnRet As Boolean      
        '用ACAD.EXE文件所在的路径来替换d:\Tahoe
        '或者你可以使用findfile()函数来找到文件的位置
blnRet = objPlot.PlotToFile("c:\temp\temp.dwf", "d:\tahoe\plotters\DWF ePlot.pc3")  
'如果打印成功则blnRet为True
objDoc.Close False
End Sub

win0757

怎样利用VBA访问图块和图块参照数据
你可使用VBA来管理图块和图块参照。图块就是关联在一起形成一个单一对象形式的对象集合，它称为图块定义。当你在图形中插入图块时，你就创建了图块参照。也就是说，图块参照引用了图块定义。区分图块定义和图块对照之间的不同是非常重要的，因为它可以帮助你明白怎样在VBA中操作这些对象。这里将通过对一个短程序的评解来解释它的操作方法。以下内容通过注释代码来示范怎样通过VBA访问图块(图块定义)和图块参照数据。
创建应用界面
假定你已经在VBA中定义了主表单，表单中有以下控件：
ListBox(列表框)：名称为 lstBlockObject  
ListBox(列表框)：名称为 lstBlockReference  
Command Button(命令按钮)：名称为 cmdCreateBlock  
Command Button(命令按钮)：名称为 cmdLister  
Command Button(命令按钮)：名称为 cmdChangeColor
创建一个模块并添加以下声明：
'图块集合
Public blkColl As AcadBlocks
'图块对象
Public BlkObj As AcadBlock
'图块参照对象
Public BlkRefrence As AcadBlockReference
'模型空间集合
Public mspace As AcadModelSpace
'图纸空间集合
Public pspace As AcadPaperSpace
Public count As Integer
Public I As Integer
Public elem As Object
Public subelem As Object
'图块插入点
Public blkInsPnt (0 To 2) As Double
Public circleObj As AcadCircle
'圆的圆心
Public center(0 To 2) As Double
'圆的半径
Public radius As Double
Public lineObj as AcadLine
'直线起点
Public startPnt (0 To 2) As Double
'直线终点
Public endPnt (0 To 2) As Double
添加以下声明到表单的初始化(Initialize)事件中：
'返回模型空间集合
Set mspace = ThisDrawing.ModelSpace
'返回图纸空间集合
Set pspace = ThisDrawing.PaperSpace
'返回图块集合
Set blkColl = ThisDrawing.Blocks
创建图块
要创建图块参照，首先你必须创建图块定义(图块)。你可以用Add方法来建立图块。建立了图块后你可以使用InsertBlock方法插入一个实例到图形中。在本例中，我们在模型空间中创建一个由一个圆和一条直线所组成的图块。添加以下代码到cmdCreateBlock按钮的Click事件过程中：
blkInsPnt(0) = 0#: blkInsPnt(1) = 0#: blkInsPnt(2) = 0#
'添加图块到图块集合中
Set BlkObj = blkColl.Add(blkInsPnt, "NewBlock")
添加图元到图块中
以下程序段提供了添加图元到图块中的代码实例。
添加圆：
center(0) = 0#: center(1) = 0#: center(2) = 0#
radius = 1
'添加圆到图块中
Set circleObj = BlkObj.AddCircle(center, radius)
添加直线：
startPnt(0) = 1#: startPnt(1) = 1#: startPnt(2) = 0#
endPnt(0) = 5#: endPnt(1) = 5#: endPnt(2) = 0#
'添加直线到图块中
Set lineObj = BlkObj.AddLine(startPnt, endPnt)
插入图块到模型空间中以下代码示范了在模型空间中插入图块：
Set BlkRefrence = mspace.InsertBlock(blkInsPnt, "NewBlock", 1#, 1#, 1#, 0)
'缩放到图块大小
ZoomExtents

访问图块和图块参照对象

VBA通过ThisDrawing对象可链接到在当前AutoCAD进程中的当前图形。通过使用ThisDrawing，你可以立刻获取访问到当前文档对象以及所有有关它的方法和属性，还有所有同一层次的其它对象。要访问图块，你可引用ThisDrawing对象；要访问图块对照，你可引用ModelSpace和PaperSpace集合。
访问图块对象
你现在必须扫描图块集合，找到图块的名称并将其放到列表框lstBlockObject中。这里有两种方法可扫描图块集合。你可使用索引来扫描图块集合。当你知道集合中包含有多少项目时，你可使用For.Next条件语句。要这样做，可添加以下代码到cmdLister按钮的Click事件过程中：
'返回图块集合中的图块数量
count = blkColl.count
'清除列表框
lstBlockObject.Clear
'创建图块列表
For I = 0 To count - 1
lstBlockObject.AddItem blkColl.Item(I).Name
Next
lstBlockObject.ListIndex = 0
注意：如果集合中有N项，则索引应该从0到N-1。
然而，一个更好的方法是使用For Each.In.Next条件语句。例如，以下语句可在集合中每一对象或阵列中的每一元素重复一组语句。VBA自动设置循环运行中每次的变量。因此你可使用以下示例重新编写先前的代码：
'清除列表框
lstBlockObject.Clear
'创建图块列表
For Each elem in ThisDrawing.Blocks
lstBlockObject.AddItem elem.Name
Next
lstBlockObject.ListIndex = 0
通过使用以上两种代码中的一种，你可以：
减少执行的次数。  
改进代码的可读性。  
减少使用变量的数量。
减少必须的错误检查(例如，条件语句的范围控制)。
执行更加精致的程序样式。
访问图块参照
要找到类似的实体，你可执行一个类似设置的操作；但这次不是搜索图块集合，这次你必须搜索AutoCAD当前文档的模型空间或图纸空间集合。要这样做，可添加以下代码到cmdLister按钮的Click事件过程中：
'清除列表框
lstBlockReference.Clear
'创建图块列表
'扫描模型空间集合
For Each elem In mspace
'只将图块参照过滤出来
If elem.EntityName = "AcDbBlockReference" Then
  lstBlockReference.AddItem elem.Name
End If
Next
lstBlockReference.ListIndex = 0
在这一点上，当你每次点击创建图块按钮时，你只有一个名为NEWBLOCK的图块在列表框lstBlockObject中。然而，一个名为NEWBLOCK的新的图块参照被添加到列表框lstBlockReference中。新的图块参照被添加，是因为你创建一个图块(图块定义)的新的引用。
注意：即便图块参照与现有的图块参照有相同的名称，但其句柄是不同的。对于AutoCAD，它们是不同的对象。
在图块中修改对象
你可在不分解图块的情况下在图块中修改其对象。要这样做，你必须进入到图块对象中，找到要修改的图元并修改其属性。以下代码示范了将直线的颜色属性改为绿色。添加以下代码到cmdChangeColor按钮的Click事件过程中：
'扫描图块集合
For Each elem In blkColl
'搜索我们所需要的图块
If elem.Name = "NewBlock" Then
'扫描图块中的图元
  For Each subelem In elem
    '过滤出直线
    If subelem.EntityName = "AcDbLine" Then
     '分配新的颜色
     subelem.Color = acRed
    End If
  Next
End If
Next
'重新生成图形
ThisDrawing.Regen True

这个代码可更改所有名为NEWBLOCK的图块参照中的直线的颜色属性。实际上是怎样发生的呢，这些代码只 了图块对象(即图块定义)中直线的颜色属性，然后图块参照即会自动更新，因为这些图块参照是引用了图块对象的。

win0757

通过VBA判断计算机的登录用户名
当前用户的登录名包含在环境变量中。你可以在命令提示行中键入命令“set”回车来查看所有的变量。
以下VB/VBA语句可取得用户名：
Dim sCurUser$
sCurUser = Environ("USERNAME")
另外，你可以加入语句将所有的字母均设为大写来避免用户有大小写之分。
另外还有一种方法可以取得登录名：
ThisDrawing.GetVariable("LOGINNAME")

win0757

怎样让图形文件以只读方式打开？
你可以在图形中嵌入一个DVB过程，捕捉保存事件，不允许用户保存。
如果通过程序以只读方式打开文件，可以这样写：
ThisDrawing.Application.Documents.Open ("MyDrawing",false)
其中false就是只读方式打开。但这样还不是能保证用户另存为其它文件。
在VBA中关闭EXCEL的问题
问：我知道怎样打开和取得EXCEL文件中的信息，但我却不能完全关闭EXCEL。用“objExcelApp.quit”看来是可以关闭，但事实上当我在下次运行VBA时发现在读取文件时有点问题。我查看了任务管理器，看到EXCEL还在其中，没有被关闭。我怎样才能将EXECL彻底关闭。
答：
这是Excel的一个BUG。你必须将所有对象释放后才能关闭Excel。
看以下的例子可以正常运行：
xlBook.close false (或 true 可保存更改内容)
xlApp.quit
set xlBook=nothing
set xlApp=nothing  

win0757

怎样在块对象中用AddDimAligned方法创建正确的标注对象
块对象的AddDimAligned方法和其它的AddDimxxx方法导致添加的标注实体不正确。这是已知的一个AutoCAD缺陷。然而，下面的方法可以克服这个缺陷。首先，在模型空间中生成一个标注实体，拷贝这个实体到所需块对象中，最后，删掉原始的标注实体。以下的事例代码生成一个块"test"，然后添加了一个DimRotated实体到块中，最后把这个块插入到模型空间中。
Sub f_SolAddDiminBlocks()
'Work around for Adding dimensions to block AutoCAD 2000
Dim po_rotDim As AcadDimAligned
Dim po_block As AcadBlock
Dim pd_ext1(0 To 2) As Double
Dim pd_ext2(0 To 2) As Double
Dim pd_lineLoc(0 To 2) As Double
Dim po_array(0) As Object
pd_ext1(0) = 3: pd_ext1(1) = 3: pd_ext1(2) = 0
pd_ext2(0) = 10: pd_ext2(1) = 3: pd_ext2(2) = 0
pd_lineLoc(0) = 5: pd_lineLoc(1) = 4: pd_lineLoc(2) = 0
'create dimeionsion object
Set po_rotDim = ThisDrawing.ModelSpace.AddDimAligned(pd_ext1, pd_ext2,
pd_lineLoc)
'create a new block by name test
Set po_block = ThisDrawing.Blocks.Add(pd_ext1, "test")
'insert a block reference
ThisDrawing.ModelSpace.InsertBlock pd_ext1, "test", 1, 1, 1, 0
'copy dimension object
Set po_array(0) = po_rotDim
ThisDrawing.CopyObjects po_array, po_block
po_rotDim.Delete
'release the references
Set po_block = Nothing
Set po_rotDim = Nothing
End Sub

win0757

如何在AutoCAD中调用具有参数的VBA函数
问：我怎样在AutoCAD中调用具有参数的VBA函数？我知道VB/A宏没有参数。Microsoft就是这样设计的。然而，VB/A函数可以带参数。我想知道是否存在命令行或者LISP的一种途径来调用VBA函数以便从AutoCAD传递必需的参数。
答：
在AutoCAD R14中， 这是不可能的。但是在AutoCAD 2000利用VBASTMT命令可以完成这项任务。这种方法仅当所调用的函数（f_test）定义在一个VBA模块中，而不是在ThisDrawing对象中有效。以下的例子说明如何具体去做。这个函数需要一个字符串参数。
Function f_test(ByVal sCommand As String)
MsgBox "This was sent from the AutoCAD Command Line: " & sCommand
End Function
在AutoCAD命令行，用VBASTMT命令。
Command: vbastmt
Expression: f_test "line 1,1 5,5 "
或者用以下的LISP代码：
(command "vbastmt" "f_test \"line 1,1 5,5 \"")

win0757

一个关于变体型数组(Variant Array)的常见VBA问题
问：我想对一个圆弧进行操作。但是当我运行下面的VBA宏时，出现一个编号为451的运行错误。它的意思是‘对象不是一个集合’。这是一个关于变体型数组(Variant Array)的常见VBA问题吗？有什么方法可以解决？
Sub showArcPoints()
Dim oEnt As Object
For Each oEnt In ThisDrawing.ModelSpace
If (TypeOf oEnt Is AcadArc) Then
' This causes Runtime error 451 - Object Not a Collection
' if oEnt is not late bound it works ok
MsgBox "StartPoint(0) is =" & oEnt.StartPoint(0)
End If
Next
End Sub
答：
当VBA从一个一般对象返回变体型数组的时候，如果这个对象是晚束缚（late bound）的话，VBA不能通过这个对象的属性返回数组的一个元素。如果这个对象是早束缚（early bound）的话，那么就不受限制。
有两种办法可以解决这个问题。其一、用AcadArc 来对此对象进行早束缚。修改好的代码如下：
Sub showArcPoints()
Dim oEnt As Object Dim oArc As AcadArc
For Each oEnt In ThisDrawing.ModelSpace
If (TypeOf oEnt Is AcadArc) Then
'This works well since it is early bound.
Set oArc = oEnt
MsgBox "StartPoint(0) = " & oArc.StartPoint(0)
End If
Next
End Sub
其二、声明一个临时的变体型变量并且把它设置为需要操作的对象属性。修改的代码如下：
Sub showArcPoints()
Dim oEnt As Object
For Each oEnt In ThisDrawing.ModelSpace
If (TypeOf oEnt Is AcadArc) Then
'This also works well.
Dim pv_temp As Variant pv_temp = oEnt.StartPoint
MsgBox "StartPoint(0) = " & pv_temp(0)
End If
Next
End Sub

win0757

怎样通过VBA读取在AutoCAD的支持目录下的文本文件？
VBA程序无法自动取得AutoCAD的支持路径，所以你要自己设定该路径给VBA程序用。AutoCAD的支持路径保存在AcadPrefeerecesFiles对象的SupportPath属性中，你可以通过读取该属性来取得支持路径并逐一查看文件是否存在。本站VBA函数中有findfile()函数可供使用。
怎样通过VBA插入图块时在选取插入点时会有图块形状与鼠标一起移动？
可以通过SendCommand函数进行，但这种方法确实不太好
ThisDrawing.SendCommand ("(command "-insert" "blockName" pause "" "" "" "")")
怎样在窗体中的文本框中高亮所有的文本，好象只用setfocus不能做到？
这样做试试
With TextBox1
.SetFocus
.SelStart = 0
.SelLength = .TextLength
End With