[求助] VB提取当前所打开的CAD文件的块属性
<p>Sub XS()<br/>Dim RowNum As Integer<br/>Dim Header As Boolean<br/>Dim elem As AcadEntity<br/>Dim Array1 As Variant<br/>Dim Count As Integer<br/>Dim acadApp As AcadApplication<br/>Dim acadDoc As AcadDocument<br/>Dim MSP As AcadEntity<br/>Dim WenZi As String<br/>On Error Resume Next<br/>RowNum = 1<br/>Header = False<br/>For Each elem In ThisDrawing.ModelSpace<br/>With elem<br/>If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then<br/>If .HasAttributes Then<br/>Array1 = .GetAttributes<br/>RowNum = RowNum + 1<br/> For Count = LBound(Array1) To UBound(Array1)<br/> WenZi = WenZi + Array1(Count).TextString + "\/"<br/> Next Count<br/> WenZi = WenZi + Chr$(13) + Chr$(10)<br/>Header = True<br/>End If<br/>End If<br/>End With<br/>Next elem<br/> FileName = "C:\XS.XS"<br/> FileNum = 1<br/> Open FileName For Output As FileNum<br/> Print #FileNum, WenZi<br/> Close #FileNum<br/>End Sub</p><p>这段程序可以将CAD图形中的块属性值提取出来，但是只能在CAD里边做为宏执行，那位大侠能帮帮帮忙移植到VB里边，用VB程序提取当前打开的CAD图形块信息，</p><p>感激不尽，谢谢了</p> <p><font face="Verdana">Sub XS()<br/> Dim RowNum As Integer<br/> Dim Header As Boolean<br/> Dim elem As Object 'AcadEntity<br/> Dim Array1 As Variant<br/> Dim Count As Integer<br/> <br/> Dim acadApp As Object 'AcadApplication<br/> Dim acadDoc As Object 'AcadDocument<br/> Dim MSP As Object 'AcadEntity<br/> Dim WenZi As String<br/> On Error Resume Next<br/> <br/> '---------------------------------------------------</font></p><p><font face="Verdana"> '新增部分<br/> Set acadApp = GetObject(, "AutoCAD.Application")<br/> If Err Then<br/> Err.Clear<br/> Set acadApp = CreateObject("AutoCAD.Application")<br/> If Err Then<br/> MsgBox Err.Description<br/> End<br/> Exit Sub<br/> End If<br/> End If<br/> acadApp.Visible = True<br/> Set acadDoc = acadApp.ActiveDocument<br/> '-----------------------------------------------------<br/> <br/> RowNum = 1<br/> Header = False<br/> For Each elem In acadDoc.ModelSpace 'ThisDrawing.ModelSpace<br/> With elem<br/> If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then<br/> If .HasAttributes Then<br/> Array1 = .GetAttributes<br/> RowNum = RowNum + 1<br/> For Count = LBound(Array1) To UBound(Array1)<br/> WenZi = WenZi + Array1(Count).TextString + "\/"<br/> Next Count<br/> WenZi = WenZi + Chr$(13) + Chr$(10)<br/> Header = True<br/> End If<br/> End If<br/> End With<br/> Next elem<br/> FileName = "C:\XS.XS"<br/> FileNum = 1<br/> Open FileName For Output As FileNum<br/> Print #FileNum, WenZi<br/> Close #FileNum<br/>End Sub</font></p>
页:
[1]