社区 › Auto Lisp › VBA新手帮助。。。

kamden 发表于 2022-7-6 22:28:14

VBA新手帮助。。。

大家好。
 
我是VBA新手，我正在尝试在Autocad中做一件看似简单的事情。
 
我正在尝试制作一个包含2个按钮和2个列表框的简单表单，具有以下功能：
 
按钮1：查找图形中所有唯一的块名，并将其放置在列表框1中
查找图形中每个唯一块名的总数，并将其添加到ListBox2。
 
 
按钮2：根据listbox1中的块名，在现成excel工作簿的某些excel单元格中传输listbox2的值。
 
按钮3：退出表单/应用程序
 
我遇到的最糟糕的问题是计算图形中的块数。我的意思是，我阅读了数百个论坛，甚至找到了现成的vba代码，但似乎没有什么能像我预期的那样工作。所以我试着从一开始就做所有的事情，但（由于我对数组或多维数组缺乏知识）我坚持要计算图形中每个唯一块名的数量，并将其添加到我的列表框中。
 
以下是我目前掌握的代码：
 
Public excelApp As Object
Public wkbkObj As Object
Public sheetObj As Object

Private Sub CommandButton1_Click()
Dim i, j, BlocksTotal As Integer
Dim Block As AcadBlockReference
Dim BlockName, UniqueBlockName As String
Dim Blk As AcadEntity

'Number of unique blocks
btot = ThisDrawing.Blocks.Count

' Every unique block name goes in Listbox1
For i = 0 To btot - 1
   UniqueBlockName = ThisDrawing.Blocks.Item(i).Name
   If Not Mid$(UniqueBlockName, 1, 1) = "*" And Not UniqueBlockName = "NAME" Then ListBox1.AddItem UniqueBlockName ' Getting rid of *ModelSpace and *PaperSpace and a wrong name of block I have in all drawings
Next i

For j = 0 To ListBox1.ListCount - 1 ' The problem is in this Loop...I cannot find a fast and easy way to count the number of every block name
    UniqueBlockName = ListBox1.List(j) 'picking up block names from listbox1
    BlocksTotal = 0
       For Each Blk In ThisDrawing.ModelSpace ' Here I want to check the name of every block in modelspace (not unique) and if it is the same as the listbox name i have to find its total number and add it to listbox 2
         If Blk.Name = UniqueBlockName Then BlocksTotal = BlocksTotal + 1
       Next
    ListBox2.AddItem BlocksTotal
Next j
End Sub

Private Sub CommandButton2_Click()
Dim i As Integer
On Error Resume Next
   Set excelApp = GetObject(, "Excel.Application")
   If Err <> 0 Then
       Err.Clear
       Set excelApp = CreateObject("Excel.Application")
               If Err <> 0 Then
         MsgBox "ÓöÜëìá êáôÜ ôçí åêêßíçóç ôïõ Excel!", vbExclamation
         End
       End If
   End If
   excelApp.Visible = True
   Set wkbkObj = excelApp.Workbooks.Open(FileName:="c:\dipola.xls")
   Set sheetObj = wkbkObj.Worksheet(2)
For i = 0 To ListBox1.ListCount - 1
   If ListBox1.List(i) = "C13" Then sheetObj.Range("A1").Value = ListBox2.List(i)
   If ListBox1.List(i) = "C1" Then sheetObj.Range("C9").Value = ListBox2.List(i)
Next i
End Sub

Private Sub CommandButton3_Click()
End
End Sub
 
有人能帮我吗，因为我花了两天时间试图找到真正有效的东西。。。我希望我有时间多读点书，尝试其他方法，但我需要它尽快，我完全困惑了
 
提前感谢。。。
 
仅供参考：我正在使用Autocad 2011 LT。

MSasu 发表于 2022-7-6 22:39:58

不确定您所说的版本（在个人资料和帖子中）-LT中没有可用的定制解决方案？！？
 
我不想让您气馁，但希望您知道，自4个版本以来，VBA已从AutoCAD中停止使用。总有一天会不再被支持。
因为你才刚刚开始，所以最好找一找。Net方法。

kamden 发表于 2022-7-6 22:47:50

问题是，我们需要这一次（为了从485个图纸生成报告）。
那么它将不再使用。
 
我在autocad中单独安装了VBA（我看到它不再受支持）。
说实话，除了我说的名字问题外，一切似乎都很好。
为了完成这一次的工作，我可以尝试在其他autocad版本以及（我有2009年和2007年安装在其他PC的太）。
 
我只需要找到正确的方法。

MSasu 发表于 2022-7-6 22:53:48

你想用这些代码实现什么？计算图形中块的实例并将其导出到Excel？有内置的BCOUNT命令可用-尽管我不确定是否在LT中可用。

MSasu 发表于 2022-7-6 22:58:32

同样，您的意思是，在AutoCAD 2011 LT上安装了VBA扩展（enabler）？

kamden 发表于 2022-7-6 23:03:40

 
我想将它们导出到excel报表的某些单元格中。
它没有express工具，而且为所有这些图形复制粘贴数千个值也很耗时。这就是为什么我们试图用代码来实现它。

Tyke 发表于 2022-7-6 23:10:48

尝试从“块”集合中获取图形中所有块的名称，并过滤每个块名称以获取块参照的实例数。然后，您可以将它们插入列表框中。
 
MSasu正确指出的一点是，您将无法在LT中运行此VBA代码。这是无法避免的。

BIGAL 发表于 2022-7-6 23:20:26

它是否有Dataextract，可以在1次输出到excel中时实现您想要的功能。

kamden 发表于 2022-7-6 23:25:40

我通过使用多维数组找到了一个完美的解决方案。
 
代码为：
 
Dim excelApp As Excel.Application
Dim wbk As Workbook
Dim sht As Worksheet

Private Sub cmdListBlocks_Click()
   
   Dim Block As AcadBlock
   Dim i As Integer
   Dim MyBlockArray() As Variant
   
   i = 0
   
   For Each Block In ThisDrawing.Blocks
   i = i + 1
   
   ReDim Preserve MyBlockArray(2, i)
       MyBlockArray(0, i) = Block.Name
       MyBlockArray(1, i) = Block.Count
   Next Block
   Me.ListBoxBlocks.ColumnCount = 2
   Me.ListBoxBlocks.ColumnWidths = "36;36"
   Me.ListBoxBlocks.Column() = MyBlockArray
End Sub

Private Sub CommandButton1_Click()

Dim i As Integer

ListCount = Me.ListBoxBlocks.ListCount

On Error Resume Next
   Set excelApp = GetObject(, "Excel.Application")
   If Err <> 0 Then
       Err.Clear
       Set excelApp = CreateObject("Excel.Application")
               If Err <> 0 Then
         MsgBox "Εrror Opening Excel!", vbExclamation
         End
       End If
   End If
   excelApp.Visible = True
   Set wkbkObj = excelApp.Workbooks.Open(FileName:="c:\dipola.xls") ' here i just open a certain excel Workbook
   Set sheetObj = wkbkObj.Worksheet(1) ' I put the values in the 2nd sheet

For i = 0 To ListCount - 1
   If ListBoxBlocks.List(i, 0) = "C1" Then Range("B1").Cells.Value = ListBoxBlocks.List(i, 1)
   If ListBoxBlocks.List(i, 0) = "C2" Then Range("B2").Cells.Value = ListBoxBlocks.List(i, 1)' Here I make a lot of checks so i just wrote two to show the way I send values to certain cells in excel
Next

wkbkObj.Sheets("DIPOLA").Select ' I focus on the 1st sheet that is the actual report page for the user to print

End Sub

Private Sub CommandButton2_Click()
End
End Sub
 
我刚刚创建了一个带有3个按钮和一个列表框的用户表单（只是为了从中读取值并将其发送到excel）。
 
我不确定它是否会在2011年起作用，但在2009年和2007年起作用。

Tyke 发表于 2022-7-6 23:30:43

 
它肯定不会在AutoCAD 2011 LT中工作，仅在AutoCAD的完整版本中工作。

查看完整版本: VBA新手帮助。。。