本例只需在Excel activeworkbook sheet1中检查单元格A1中的值,并将该值加载到可以传递到AutoCAD图形的变量中。我一时想不起来如何更改或设置被覆盖的值,但您可能已经做到了,所以您只需将该变量从Excel函数传递给AutoCAD即可。
“Fs=”&newVal&“in”
============裸Excel单元格值到AutoCAD-VB连接
- Private Sub CommandXL1_Click()
- Dim AutoCAD As acadapplication
- Dim Thisdrawing As AcadDocument 'as Object
- Dim activedocument As Object
- Dim SSET2 As Object
- Dim ent As AcadEntity 'as Object
- Dim Excel As Object
- Dim excelSheet As Object
- Dim application As Object
- Dim newVal As String
- Dim newValtoAcad As String
- 'On Error Resume Next
- Set Excel = GetObject(, "Excel.Application")
- If Err <> 0 Then
- Err.Clear
- Set Excel = CreateObject("Excel.Application")
- If Err <> 0 Then
- MsgBox "Could not load Excel.", vbExclamation
- End
- End If
- End If
- Set excelSheet = Excel.ActiveWorkbook.Sheets("Sheet1")
- Set acadapp = GetObject(, "autocad.application")
- Set Thisdrawing = acadapp.activedocument
- Set SSET2 = Thisdrawing.SelectionSets.Add(str(Timer))
- SSET2.SelectOnScreen
- R = 1
- 'YOU'LL HAVE TO EXPERIMENT HERE
- For Each ent In SSET2
- newVal = excelSheet.Cells(R, 1).Value
- newValtoAcad = "Fs = " & newVal & "in"
- Next ent
- End Sub
=============================
另一种有一些真正破解可能性的替代方法是将Excel命名范围与AutoCAD组名相关联,然后您可以仔细阅读Excel名称并获取其值,并通过使用AutoCAD中的命名选择集(即“组名”)从逻辑上选择相同的“名称”。
==========例如提取
- For x = 1 To Excel.application.Names.count 'see in context below
- excname = Excel.application.Names(x).Name
- strgroup = Trim(UCase(excname))
- Set SSET2 = Thisdrawing.Groups.Item(strgroup)
- Set objGroups = Thisdrawing.Groups
- If UCase(objGroup.Name) = strgroup Then
- DoEvents
- Thisdrawing.Groups.Item(strgroup).Item(0).TextString = Excel.application.Range(excname).Value
- Thisdrawing.Groups.Item(strgroup).Item(0).Highlight True
- End If
- Next
在具有Excel命名范围和AutoCAD组名的例程中
- Private Sub CommandXL2_Click()
- On Error Resume Next
- Dim AutoCAD As acadapplication
- Dim Thisdrawing As AcadDocument
- Dim activedocument As Object
- Dim SSET2 As Object
- Dim Excel As Object
- Dim excelSheet As Object
- Dim application As Object
- Dim strgroup As String
- Set Excel = GetObject(, "Excel.Application") 'connect to open excel session
- If Err <> 0 Then
- Err.Clear
- Set Excel = CreateObject("Excel.Application") 'open an excel application session (if you know it's going to be available, delete this)
- If Err <> 0 Then
- MsgBox "Could not load Excel.", vbExclamation
- End
- End If
- End If
- ''On Error Resume Next
- Set acadapp = GetObject(, "autocad.application") 'connect to AutoCAD app
- Set Thisdrawing = acadapp.activedocument
- DoEvents
- For x = 1 To Excel.application.Names.count 'cycle through names in Excel
- excname = Excel.application.Names(x).Name 'Set excel name to a var
- strgroup = Trim(UCase(excname)) 'set var to correlate to acad group name, set to upper case for a consistent pattern, all upper, no case sensitivity
- Set SSET2 = Thisdrawing.Groups.Item(strgroup) 'relate the excname, to it's correlated acad group name, and select by that name
- Set objGroups = Thisdrawing.Groups 'set acad groups obj
- If UCase(objGroup.Name) = strgroup Then
- DoEvents
- Excel.application.Range(excname).Value = UCase(Thisdrawing.Groups.Item(excname).Item(0).TextString) 'set excel value from acad
- 'the below flips the data transfer
- UCase(Thisdrawing.Groups.Item(excname).Item(0).TextString) = Excel.application.Range(excname).Value 'set acad value from excel
- End If
- Next
- End Sub
|