在Excel中输入以下程序
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
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) = ""
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
置顶卡
