嗯,我试过了,但我仍然在同一个位置遇到同样的错误……奇怪。你看到什么不正确的地方了吗
- Sub Import_POLYLINES()
-
-
- 'for Excel sheet managing purposes
- Dim MySht As Worksheet
- Dim MyCell As range
- 'for Autocad application managing purposes
- Dim ACAD As AcadApplication
- Dim ThisDrawing As AcadDocument
- Dim LWPoly As AcadLWPolyline
- Dim oEnt As AcadEntity
- ' for selection set purposes
- Dim ssetObj As AcadSelectionSet
- Dim gpCode(0) As Integer
- Dim dataValue(0) As Variant
- 'for general variables managing purposes
- Dim iRow As Long
- Dim LWArea As Double, LWZ As Double
- ' Autocad Session handling
- On Error Resume Next
- Set ACAD = GetObject(, "AutoCAD.Application")
- On Error GoTo 0
- If ACAD Is Nothing Then
- Set ACAD = New AcadApplication
- ACAD.Visible = True
- End If
- Set ThisDrawing = ACAD.ActiveDocument
-
- ' selecting LwPolylines on screen by selelection set filtering method
- ' managing potential selection set exsistence
- On Error Resume Next
- Set ssetObj = ThisDrawing.SelectionSets.Item("LWPolySSET")
- If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("LWPolySSET")
- On Error GoTo 0
- ssetObj.Clear
-
- 'setting filtering critera
- gpCode(0) = 0
- dataValue(0) = "LWPOLYLINE"
-
- 'selecting LWPolylines
- ssetObj.SelectOnScreen gpCode, dataValue
- ' processing LWPolylines
- If ssetObj.Count > 0 Then
-
- ' writing sheet headings
- Set MySht = ActiveSheet
- Set MyCell = MySht.Cells(11, 1) 'Where to Start the Excel Cell Input X, Y
- With MyCell
- '.Offset(0, 0).Value = "LWPoly nr"
- '.Offset(0, 1).Value = "Area S.F."
- '.Offset(0, 0) = "Elevation"
- End With
-
- 'clearing previous written data
- iRow = MySht.Cells(MySht.Rows.Count, 1).End(xlUp).Row
- If iRow > 1 Then MyCell.Offset(1, 0).Resize(iRow - 1, 2).Clear
-
- 'retrieving LWPolys data and writing them on worksheet
- iRow = 1
- For Each oEnt In ssetObj
- If TypeOf oEnt Is AcadLWPolyline Then
- Set LWPoly = oEnt
-
- 'retrieving LWPoly data
- With LWPoly
- LWArea = .area
- LWZ = .Elevation
- End With
-
- ' writing LWPoly data
- With MyCell
- '.Offset(iRow, 0).Value = "LWPoly nr." & iRow
- .Offset(iRow, 1).Value = LWArea
- .Offset(iRow, 0) = LWZ
- End With
- iRow = iRow + 1
-
- End If
-
- Next oEnt
-
- End If
- ' cleaning up before ending
- ssetObj.Delete
- Set ssetObj = Nothing
- Set ThisDrawing = Nothing
- Set ACAD = Nothing
- End Sub
|