- UID
- 16855
- 积分
- 167
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2002-11-24
- 最后登录
- 1970-1-1
|
发表于 2005-10-9 20:50:51
|
显示全部楼层
这个功能不难实现,把具体情况发到我信箱吧,最好附张图.gjilang01@163.com。
看了下面朋友的例子,改了一下,应该可以使用了.
Sub test()
On Error Resume Next
Dim ent As Object
Dim m As Integer
Dim xl As Excel.Application
Dim xb As Excel.Workbook
Dim xs As Excel.Worksheet
On Error Resume Next
Set xl = GetObject(, "excel.application")
If Err Then
Err.Clear
Set xl = CreateObject("eccel.application")
If Err Then
MsgBox "excel isn't started"
Exit Sub
End If
End If
Set xb = xl.Workbooks.Add
Set xs = xb.ActiveSheet
For Each ent In ThisDrawing.ModelSpace
If TypeOf ent Is AcadCircle Then
Dim r As Variant
Dim centpt As Variant
Dim cpt(0 To 2) As Double
r = ent.Radius
centpt = ent.Center
cpt(0) = centpt(0): cpt(1) = centpt(1)
End If
m = m + 1
xl.Visible = True
xs.Cells(1, 1) = ("半径")
xs.Cells(1, 2) = ("X坐标")
xs.Cells(1, 3) = ("Y坐标")
xs.Cells(m + 1, 1) = r
xs.Cells(m + 1, 2) = cpt(0)
xs.Cells(m + 1, 3) = cpt(1)
Next
End Sub
基本上能满足你所说的要求,如果有其它的需求,请说明!使用时,请先把引用excel库 |
|