胡日查 18:09:05
这与0几没关系
都可以运行
胡日查 18:10:33
我自己可以把坐标放到excel,但是响应回车我还不会
无痕/ws 18:11:05
哦,能帮我写个吗?我只看到论坛中有ACAD图形中选择对象并将对象部分属性写入EXCEL文档
Sub WriteExcel()
Dim ExcelApp As New Excel.Application
Dim ExcelWkbk As Excel.Workbook
Set ExcelWkbk = ExcelApp.Workbooks.Add
Dim sel As AcadSelectionSet
Dim i As Integer
i = 2
On Error Resume Next
Set sel = ThisDrawing.SelectionSets.Add("ssel")
If Err Then
Err.Clear
Set sel = ThisDrawing.SelectionSets.Item("ssel")
End If
On Error GoTo 0
sel.SelectOnScreen
Dim Ent As AcadEntity
Dim pt1 As Variant, pt2 As Variant
MsgBox ExcelWkbk.Name
With ExcelWkbk.Worksheets("sheet1")
For Each Ent In sel
Select Case UCase(Ent.ObjectName)
Case "ACDBLINE":
.Range("A" & i) = "直线"
pt1 = Ent.StartPoint
pt2 = Ent.EndPoint
.Range("B" & i) = pt1(0)
.Range("c" & i) = pt1(1)
.Range("D" & i) = pt2(0)
.Range("E" & i) = pt2(1)
i = i + 1
Case "ACDBCIRCLE":
.Range("A" & i) = "圆"
pt1 = Ent.Center
.Range("B" & i) = pt1(0)
.Range("C" & i) = pt1(1)
.Range("D" & i) = Ent.Radius
i = i + 1
Case Else:
End Select
Next Ent
End With
ExcelApp.ActiveWorkbook.SaveAs "d:ook1.xls"
ExcelApp.Workbooks.Close
ExcelApp.Quit
sel.Delete
End Sub
无痕/ws 18:12:02
不知道如何实现点选图中文本,自动给点选的文本编上个号以便于区别,并写入到excel
无痕/ws 18:13:25
回车麻烦也可以设置其他条件来结束程序。
胡日查 18:13:43
我看看
无痕/ws 18:14:32
嗯,谢谢了。
胡日查 18:15:51
你的cad文件在吗?
给我传过来
无痕/ws 18:16:35
稍等
胡日查 18:17:50
编号有过滤吗,还是随机给编号?
规律
胡日查 18:19:07
哥们?
不在啊?
无痕/ws 18:19:18
在
胡日查 18:19:25
回答我
无痕/ws 18:19:32
不好意思,编号自然数就可以
胡日查 18:19:44
随机?
无痕/ws 18:20:04
连续的1,2,3...
胡日查 18:20:11
好
给我文件
胡日查 18:20:53
这个弄好了我自己也能用
无痕/ws 18:21:17
谢谢 |