跪求高手

kids

我想做这样一件事：
      在我的当前图形里有很多圆，我想一次将每个圆的圆心坐标输出到txt文件中，哪位高手能帮帮我，谢谢！

zhuirvine

你想用哪种方式实现啊，是用.COM引用呢，还是那个DLL呢。。反正思路是一样的，弄个带过滤的选择集，选择源，然后遍历里面的元素，直接将每个元素的圆心输出到TXT。。就这么简单啦。。

kids

zhuirvine 发表于 2011-11-17 22:59
你想用哪种方式实现啊，是用.COM引用呢，还是那个DLL呢。。反正思路是一样的，弄个带过滤的选择集，选择源， ...

恩 ，我这两天研究了下，我是用VBA做的，但是我现在做到能遍历每个圆，但是不知道怎么输出到TXT文件中，高手能不能指点下

guohq

2. Sub WriteCir()
   
3. 
   
4.     Dim ss As AcadSelectionSet
   
5.     If IsNull(ThisDrawing.SelectionSets.Item("cir")) Then
   
6.         Set ss = ThisDrawing.SelectionSets.Add("cir")
   
7.         Else
   
8.         Set ss = ThisDrawing.SelectionSets.Item("cir")
   
9.         ss.Clear
   
10.     End If
    
11.       
    
12.    
    
13.     Dim gpCode(0) As Integer
    
14.     Dim dataValue(0) As Variant
    
15.     gpCode(0) = 0
    
16.     dataValue(0) = "Circle"
    
17.    
    
18.     Dim groupCode As Variant, dataCode As Variant
    
19.     groupCode = gpCode
    
20.     dataCode = dataValue
    
21. 
    
22.    
    
23.     ss.Select acSelectionSetAll, , , groupCode, dataCode
    
24.    
    
25.     Dim cir As AcadCircle, obj As AcadEntity
    
26.     Dim pt  As Variant
    
27. 
    
28.     Dim fso As Object
    
29.     Set fso = CreateObject("Scripting.FileSystemObject")
    
30.     Dim pfile As Object
    
31.     Set pfile = fso.CreateTextFile("c:\ttttt.txt", True)
    
32.    
    
33.     For Each obj In ss
    
34.        Set cir = obj
    
35.        pt = cir.Center
    
36.        pfile.WriteLine (pt(0) & "   " & pt(1))
    
37.     Next
    
38. 
    
39.     pfile.Close
    
40. End Sub

Sub WriteCir()<br /> <br />     Dim ss As AcadSelectionSet<br />     If IsNull(ThisDrawing.SelectionSets.Item("cir")) Then<br />         Set ss = ThisDrawing.SelectionSets.Add("cir")<br />         Else<br />         Set ss = ThisDrawing.SelectionSets.Item("cir")<br />         ss.Clear<br />     End If<br />        <br />     <br />     Dim gpCode(0) As Integer<br />     Dim dataValue(0) As Variant<br />     gpCode(0) = 0<br />     dataValue(0) = "Circle"<br />     <br />     Dim groupCode As Variant, dataCode As Variant<br />     groupCode = gpCode<br />     dataCode = dataValue<br /> <br />     <br />     ss.Select acSelectionSetAll, , , groupCode, dataCode<br />     <br />     Dim cir As AcadCircle, obj As AcadEntity<br />     Dim pt  As Variant<br /> <br />     Dim fso As Object<br />     Set fso = CreateObject("Scripting.FileSystemObject")<br />     Dim pfile As Object<br />     Set pfile = fso.CreateTextFile("c:\ttttt.txt", True)<br />    <br />     For Each obj In ss<br />        Set cir = obj<br />        pt = cir.Center<br />        pfile.WriteLine (pt(0) & "   " & pt(1))<br />     Next<br /> <br />     pfile.Close<br /> End Sub

kids

guohq 发表于 2011-11-19 23:23

谢谢  但是程序运行时报错  未找到主键

guohq

我测试过，可以运行的，你自己可以设断点调试一下，看哪句话出错了

sailorcwx

在一开始增加一个On Error Resume Next
因为一开始没有cir选集的话，ThisDrawing.SelectionSets.Item("cir")就会出错

kids

sailorcwx 发表于 2011-11-22 12:19
在一开始增加一个On Error Resume Next
因为一开始没有cir选集的话，ThisDrawing.SelectionSets.Item("cir ...

恩  是这样的  谢谢

guohq

呵呵，不怎么用VBA，没有考虑到这些