悬赏，如可统计周长孔得出个数并得出表？？？？

CAD83 · 发表于 2012-9-7 19:25

本帖最后由 CAD83 于 2012-9-8 18:55 编辑

如可统计周长孔得出个数并得出表，哪位出手写下，自己没这个能力，请看图例。。。。。

200853006 · 发表于 2012-9-8 09:33

顶，期待。。。

CAD83 · 发表于 2012-9-8 13:34

本帖最后由 CAD83 于 2012-9-8 13:38 编辑

悬赏在哪按了，记不住了，哪位写了给4个明经币，

CAD83 · 发表于 2012-9-8 18:47

yjr111悬赏某问题，出下手啊，

yjr111 · 发表于 2012-9-8 22:35

CAD83 发表于 2012-9-8 18:47
yjr111悬赏某问题，出下手啊，

下了测试图看来一下
1、都是直线画的，如果首尾相连，还可以用转化多义线解决，否则不好搞；
2、表示类型的文字在异型孔范围内会准确，否则不好选文字，容易出错；

sscylh · 发表于 2012-9-9 11:18

不会....
留下的脚印,看以后学多了会不会...
另,替楼主顶下,希望高手早点出手!

sscylh · 发表于 2012-9-9 11:22

不知道vba会不会好点...
思路:提取对象,if判断其是否是文字,若是,加入字典(scripting.dictionary),再做统计..只是还不知道表格怎么做
反正vba可以和excel连接,生成表格到excel中行不楼主?

sscylh · 发表于 2012-9-9 11:52

用vba编了一个,在我这边调试通过(不过没有完全达到楼主的意思,我的是把表格做成excel而非cad)

Sub aa()
'需先:工具-引用microsoft excel 11.0 object library
Dim d
Dim xlsapp As Excel.Application
Set xlsapp = CreateObject("excel.application")
Set d = CreateObject("scripting.dictionary")
Dim s As AcadText
For i = 1 To ThisDrawing.ModelSpace.Count
If ThisDrawing.ModelSpace(i - 1).ObjectName = "AcDbText" Then
Set s = ThisDrawing.ModelSpace(i - 1)
d(s.TextString) = d(s.TextString) + 1
End If
Next
xlsapp.Workbooks.Open ThisDrawing.Path & "\book1.xls"
xlsapp.Workbooks(1).Sheets(1).[a1].Resize(d.Count, 1) = xlsapp.WorksheetFunction.Transpose(d.keys)
xlsapp.Workbooks(1).Sheets(1).[b1].Resize(d.Count, 1) = xlsapp.WorksheetFunction.Transpose(d.items)
xlsapp.Workbooks(1).Save
xlsapp.Quit
End Sub

CAD83 · 发表于 2012-9-9 13:33

都是首尾相连，但不单是直线哟，也有圆弧，在此谢下sscylh ，只是没有完全达要求，呵，

lish · 发表于 2012-11-6 18:42

看看！！！！！！！！！！！

账号		自动登录	找回密码
密码			注册