在Excel中起动AutoCAD

兰州人

在Excel中输入以下程序
Sub ls()
  Dim AppCAD As AcadApplication
  On Error Resume Next
  Set AppCAD = GetObject(, "AutoCAD.Application")
  If Err Then
    Debug.Print Err.Number
    Err.Clear
    Set AppCAD = CreateObject("AutoCAD.Application")
  End If
  AppCAD.Visible = True
  Dim objModelSpace As AcadModelSpace
  Dim objDocument As AcadDocument
  Set objModelSpace = AppCAD.ActiveDocument.ModelSpace
  Set objDocument = AppCAD.ActiveDocument
  
End Sub

2. Sub lll()
3.   Dim objRegion As Variant
4.   Dim objCurve() As AcadEntity
5.   With ConnectCad.ActiveDocument
6.     ReDim objCurve(Range("A65366").End(xlUp).Row - 2) As AcadEntity
7.     Debug.Print Range("A65366").End(xlUp).Row, .ModelSpace.Count - 1
8.     For ii = 2 To Range("A65366").End(xlUp).Row
9.       Set objCurve(ii - 2) = .HandleToObject(Cells(ii, 1))
10.     Next ii
11.     Dim regionObj As Variant
12.     regionObj = .ModelSpace.AddRegion(objCurve)
13.     ' Define the extrusion
14.     Dim Height As Double
15.     Dim taperAngle As Double
16.     Height = 20
17.     taperAngle = 0
18.    
19.     ' Create the solid
20.     Dim SolidObj As Acad3DSolid
21.     Set SolidObj = .ModelSpace.AddExtrudedSolid(regionObj(0), Height, taperAngle)
22.     SolidObj.Color = 1
23.    
24.     ' Change the viewing direction of the viewport
25.     Dim NewDirection(0 To 2) As Double
26.     NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
27.     .ActiveViewport.Direction = NewDirection
28.     .ActiveViewport = .ActiveViewport
29.     ZoomExtents
30.   End With
31. End Sub

Sub lll()   Dim objRegion As Variant   Dim objCurve() As AcadEntity   With ConnectCad.ActiveDocument     ReDim objCurve(Range("A65366").End(xlUp).Row - 2) As AcadEntity     Debug.Print Range("A65366").End(xlUp).Row, .ModelSpace.Count - 1     For ii = 2 To Range("A65366").End(xlUp).Row       Set objCurve(ii - 2) = .HandleToObject(Cells(ii, 1))     Next ii     Dim regionObj As Variant     regionObj = .ModelSpace.AddRegion(objCurve)     ' Define the extrusion     Dim Height As Double     Dim taperAngle As Double     Height = 20     taperAngle = 0         ' Create the solid     Dim SolidObj As Acad3DSolid     Set SolidObj = .ModelSpace.AddExtrudedSolid(regionObj(0), Height, taperAngle)     SolidObj.Color = 1         ' Change the viewing direction of the viewport     Dim NewDirection(0 To 2) As Double     NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1     .ActiveViewport.Direction = NewDirection     .ActiveViewport = .ActiveViewport     ZoomExtents   End With End Sub

2. Function ConnectCad() As AcadApplication
3.   Dim App As AcadApplication
4.   On Error Resume Next
5.   Set App = GetObject(, "AutoCAD.Application")
6.   If Err Then
7.     Err.Clear
8.     Set App = CreateObject("AutoCAD.Application")
9.   End If
10.   App.Visible = True
11.   Set ConnectCad = App
12. End Function
13. Function GetCornerSelect(sSetName As String, fTypeVariant As Variant, fDataVariant As Variant) As AcadSelectionSet
14.    ''
15.    Dim sSet As AcadSelectionSet
16.    ''
17.    Dim fType() As Integer, fData() As Variant
18.    ReDim fType(UBound(fTypeVariant) + 2) As Integer: ReDim fData(UBound(fDataVariant) + 2) As Variant
19.    fType(0) = -4: fData(0) = "<Or"
20.    For ii = 0 To UBound(fTypeVariant)
21.      fType(ii + 1) = fTypeVariant(ii): fData(ii + 1) = fDataVariant(ii)
22.    Next ii
23.    fType(UBound(fType)) = -4: fData(UBound(fData)) = "Or>"
24.    
25.    Dim Pt1, Pt2
26.    With ConnectCad.ActiveDocument
27.      ''
28.      On Error Resume Next
29.      Set sSet = .SelectionSets.Item(sSetName)
30.      sSet.Delete
31.      Set sSet = .SelectionSets.Add(sSetName)
32.      ''
33.      Pt1 = .Utility.GetPoint(, "Select Forst Point")
34.      Pt2 = .Utility.GetCorner(Pt1, "Select Corner Point")
35.      sSet.Select acSelectionSetCrossing, Pt1, Pt2, fType, fData
36.    End With
37.    Set GetCornerSelect = sSet
38. End Function
39. Sub l()
40.   Dim sSet As AcadSelectionSet
41.   Dim fType() As Integer, fData() As Variant
42.   nn = 0
43.   ReDim fType(nn) As Integer: ReDim fData(nn) As Variant
44.   fType(0) = 8: fData(0) = "0"
45.   Set sSet = GetCornerSelect("testSset", fType, fData)
46. End Sub

Function ConnectCad() As AcadApplication   Dim App As AcadApplication   On Error Resume Next   Set App = GetObject(, "AutoCAD.Application")   If Err Then     Err.Clear     Set App = CreateObject("AutoCAD.Application")   End If   App.Visible = True   Set ConnectCad = App End Function Function GetCornerSelect(sSetName As String, fTypeVariant As Variant, fDataVariant As Variant) As AcadSelectionSet    ''    Dim sSet As AcadSelectionSet    ''    Dim fType() As Integer, fData() As Variant    ReDim fType(UBound(fTypeVariant) + 2) As Integer: ReDim fData(UBound(fDataVariant) + 2) As Variant    fType(0) = -4: fData(0) = "<Or"    For ii = 0 To UBound(fTypeVariant)      fType(ii + 1) = fTypeVariant(ii): fData(ii + 1) = fDataVariant(ii)    Next ii    fType(UBound(fType)) = -4: fData(UBound(fData)) = "Or>"        Dim Pt1, Pt2    With ConnectCad.ActiveDocument      ''      On Error Resume Next      Set sSet = .SelectionSets.Item(sSetName)      sSet.Delete      Set sSet = .SelectionSets.Add(sSetName)      ''      Pt1 = .Utility.GetPoint(, "Select Forst Point")      Pt2 = .Utility.GetCorner(Pt1, "Select Corner Point")      sSet.Select acSelectionSetCrossing, Pt1, Pt2, fType, fData    End With    Set GetCornerSelect = sSet End Function Sub l()   Dim sSet As AcadSelectionSet   Dim fType() As Integer, fData() As Variant   nn = 0   ReDim fType(nn) As Integer: ReDim fData(nn) As Variant   fType(0) = 8: fData(0) = "0"   Set sSet = GetCornerSelect("testSset", fType, fData) End Sub

zoe5306

感觉还不错 补充一下 得将excel的VBA编辑器中 工具-引用-AUTOCAD 类型库选中哦。