|
|
发表于 2007-5-26 23:57:00
|
显示全部楼层
我编了这几句，哪位朋友能帮我优化一下吗？
Sub CX()
Dim uselect As AcadSelectionSet
Dim mj As String, zc As String
Dim Excelapplication As Excel.Application
Dim Excelsheet As worksheet
With ThisDrawing
On Error Resume Next
.SelectionSets("currentselection").Delete
Set uselect = .SelectionSets.Add("currentselection")
uselect.SelectOnScreen
For Each objselect In uselect
mj = objselect.Area
zc = objselect.Length
Next
' MsgBox "面积= " & mj & " !", vbInformation '信息框
End With
On Error Resume Next
Set Excelapplication = New Excel.Application
Excelapplication.Visible = True 'False
Excelapplication.workbooks.Add
Set Excelsheet = Excelapplication.activeworkbook.sheets("sheet1")
Excelsheet.cells(1, 1).Value = "面积"
Excelsheet.cells(1, 2).Value = "周长"
Excelsheet.cells(2, 1).Value = mj
Excelsheet.cells(2, 2).Value = zc
End Sub |
|
置顶卡
