将Excel VBA链接到acad
大家好，我对我的项目印象深刻。如何使用VBA通过Microsoft excel更改Auto cad块属性。请指导使用VBA代码。
示例：Excel在单元格1到10中有一些值，必须通过VBA代码在Auto cad块属性中获取这些值。请尽快回复任何一个
提前谢谢。 你的意思是所有这些属性都将应用于单个块，即你将在屏幕上被选中，
或者你想将这些值应用于全球许多区块，很高兴知道
本例中的块名称
同时，这个Excel文件是在之前打开的还是您需要在会话中从中打开它
文件对话框？
您的Acad版本和平台是什么？ 这是一个非常基本的例子
Option Explicit
'' Require Reference to:
'' Tools--> References --> Microsoft Excel 1X.0 Type Library
'' and also you have to set options here:
'' Tools--> Options --> Genetral --> Error Trapping -> check 'Break on Unhahdled Errors'
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ''
Const xlFileName As String = "C:\Test\TitleBlock.xls" '<-- change data file name
Const sheetName As String = "MyAttributes" '<-- change sheet name
Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
''------------Late binding example:------------------''
Sub LateBindingExcel()
Dim xlApp As Object
Dim xlBooks As Object
Dim xlBook As Object
Dim xlSheets As Object
Dim xlSheet As Object
Dim xlCells As Object
Dim xlRange As Object
On Error GoTo Err_Control
On Error Resume Next
Set xlApp = Nothing
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlApp = CreateObject("Excel.Application")
End If
Err.Clear
Set xlBooks = xlApp.Workbooks
If xlBooks.Count > 0 Then
Set xlBook = xlBooks.Item(1)
End If
If xlBooks.Count = 0 Then
Set xlBook = xlBooks.Open(xlFileName, False)
End If
Set xlSheets = xlBook.worksheets
Set xlSheet = xlSheets.Item(sheetName)'<--- change a sheet name (might be a sheet number instead)
xlSheet.Application.Visible = True
Set xlCells = xlSheet.Cells
Set xlRange = xlCells.Range("$A1:$A10")
Dim i As Long
i = 1
Dim strAddr As String
Dim attrData(0 To 9) As String
For i = 1 To 10
strAddr = "A" & CStr(i)
Set xlRange = xlCells.Range(strAddr)
Dim cellVal
cellVal = xlRange.Value
attrData(i - 1) = CStr(cellVal) '<-- store data you took from Excel for the future use
Next
ThisDrawing.Activate
' keep this order
Set xlRange = Nothing
Set xlCells = Nothing
Set xlSheet = Nothing
Set xlSheets = Nothing
xlBook.Close False
Set xlBook = Nothing
Set xlBooks = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox "Select blocks"
''------------- End of Excel work-----------------''
Dim oEnt As AcadEntity
Dim oBlkRef As AcadBlockReference
Dim oAttrib As AcadAttributeReference
Dim attValAs Variant
Dim ftype(0 To 1) As Integer
Dim fdata(0 To 1) As Variant
Dim dxfCode, dxfValue
ftype(0) = 0: fdata(0) = "insert"
ftype(1) = 66: fdata(1) = 1
dxfCode = ftype: dxfValue = fdata
Dim oSset As AcadSelectionSet
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set oSset = .Add("$MyBlocks$")
End With
oSset.SelectOnScreen dxfCode, dxfValue
If oSset.Count = 0 Then
MsgBox "nothing selected, exit..."
Exit Sub
End If
For Each oEnt In oSset
Set oBlkRef = oEnt
attVal = oBlkRef.GetAttributes
For i = LBound(attrData) To (UBound(attrData)) '<-- assuming a contents size of the stored data
Set oAttrib = attVal(i)
If attrData(i) <> vbNullString Then
oAttrib.TextString = attrData(i)
End If
Next i
Next oEnt
Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
你好
我想将excel单元格值链接到autocad属性块。运行VBA时，excel值必须更新块内属性值。块属性名称是常量，唯一的变量是excel值。我有一个在excel中打开acad的代码。
但我只需要这个选项的代码。请任何人帮我通过任何代码。 尊敬的Fixo：，
我对这个很陌生。HANDLETOOBJECT是什么。
我的问题是excel单元格中有10个变量值（即：10个单元格）。&我在acad中有恒定的10个块属性。
在运行VBA时，这些excel文本必须粘贴到10块属性值的acad文本中。
先生，请帮我接通密码。 块名称和属性标记是什么？ 块名称是一个，属性标记是结构，只有块值必须更新 我合并了你所有的线程。 我不能把你的作业做完，
最好查看帮助文件，文档，搜索所需信息
在本论坛和其他论坛上
添加您需要自己筛选的块名，
这是我在这个帖子中的最后一篇帖子
dim obj as AcadEntity
Dim oText as AcadText
dim handlerange as range
dim textrange as range
set handlerange=mySheet.Range("A1000")
set textrange=mySheet.Range("B1000")
Set obj= thisdrawing.HandleToObject(range.Value)
set txtobj= obj
txtobj.TextString= textrange.value''--> or value2
~'J'~ 尊敬的fixo：，
你能发布你的VBAExcelAutoCAD吗。请再说一遍？链接现在已断开。
当做
页:
[1]
2