网上不一定有能人啊呀!

jxb8888

我有一个问题,就是"在AutoCAD中用VBA或Visual LISP中写一个程式,能在AUTOCAD中选中一个封闭的多义线(在封闭的多义线中有直线,倒圆角,圆弧,角度)按逆时针找出每一个2D坐标,写在一个文本文件里!
我在网上坛子里问了三个月了,十几个人说来说去,都没搞定.

mccad

不知以下程序是否可用：

2. Sub oef()
   
3.     Dim pnt As Variant
   
4.     Dim ent1 As AcadLWPolyline
   
5.     Dim ent2 As AcadLWPolyline
   
6.     Dim ents As Variant
   
7.     Dim pnts As Variant
   
8.     Dim cnt As Integer
   
9.     Dim cor() As Double
   
10.     Dim i As Integer
    
11.     Dim txt As String
    
12.     ThisDrawing.Utility.GetEntity ent1, pnt
    
13.     pnts = ent1.Coordinates
    
14.     cnt = (UBound(pnts) + 1) / 2
    
15.     Debug.Print cnt
    
16.     ReDim cor(1, cnt) As Double
    
17.     For i = 0 To UBound(pnts) Step 2
    
18.         cor(0, i / 2) = ent1.Coordinates(i)
    
19.         cor(1, i / 2) = ent1.Coordinates(i + 1)
    
20.     Next
    
21.     ents = ent1.Offset(10)
    
22.     Set ent2 = ents(0)
    
23.     If ent2.Area > ent1.Area Then
    
24.         txt = "逆时针方向，其逆时针坐标如下："
    
25.         For i = 0 To UBound(cor, 2) - 1
    
26.             txt = txt & vbCr & cor(0, i) & "," & cor(1, i)
    
27.         Next
    
28.     Else
    
29.          txt = "线为顺时针方向，已经转换为逆时针的坐标如下："
    
30.         For i = UBound(cor, 2) - 1 To 0 Step -1
    
31.             txt = txt & vbCr & cor(0, i) & "," & cor(1, i)
    
32.         Next
    
33.     End If
    
34.     For i = 0 To UBound(ents)
    
35.         ents(i).Delete
    
36.     Next
    
37.     MsgBox txt
    
38.         
    
39. End Sub
    

Sub oef()<br />     Dim pnt As Variant<br />     Dim ent1 As AcadLWPolyline<br />     Dim ent2 As AcadLWPolyline<br />     Dim ents As Variant<br />     Dim pnts As Variant<br />     Dim cnt As Integer<br />     Dim cor() As Double<br />     Dim i As Integer<br />     Dim txt As String<br />     ThisDrawing.Utility.GetEntity ent1, pnt<br />     pnts = ent1.Coordinates<br />     cnt = (UBound(pnts) + 1) / 2<br />     Debug.Print cnt<br />     ReDim cor(1, cnt) As Double<br />     For i = 0 To UBound(pnts) Step 2<br />         cor(0, i / 2) = ent1.Coordinates(i)<br />         cor(1, i / 2) = ent1.Coordinates(i + 1)<br />     Next<br />     ents = ent1.Offset(10)<br />     Set ent2 = ents(0)<br />     If ent2.Area > ent1.Area Then<br />         txt = "逆时针方向，其逆时针坐标如下："<br />         For i = 0 To UBound(cor, 2) - 1<br />             txt = txt & vbCr & cor(0, i) & "," & cor(1, i)<br />         Next<br />     Else<br />          txt = "线为顺时针方向，已经转换为逆时针的坐标如下："<br />         For i = UBound(cor, 2) - 1 To 0 Step -1<br />             txt = txt & vbCr & cor(0, i) & "," & cor(1, i)<br />         Next<br />     End If<br />     For i = 0 To UBound(ents)<br />         ents(i).Delete<br />     Next<br />     MsgBox txt<br />         <br /> End Sub<br />

jxb8888

好像你只能找到一条直线的两个点,不能找多个点,比如下图的所有直线,倒圆角,圆弧,角度的点,就没有办法!

jxb8888

运行你那代码出错:
     Run-time error ‘-2147418113(8000ffff):
  Method ‘offset’ of object ‘iacadlwpolyline’failed
经调试出错代码为;
ents = ent1.Offset(10)
怎么办?????

fsq12

惨了

mccad

注意你的条件是：
选中一个封闭的多义线(在封闭的多义线中有直线,倒圆角,圆弧,角度)
所以程序也只考虑到你所说的多义线的情况。

jxb8888

我那是封闭的多义线啊!只是画好了,用PE命令连接成一条啊!

mccad

我按照你所说的方法画线，圆角，再PE成多段线，但没有你所说的问题：

jxb8888

请问你用的AUTOCAD是什么版本?

jxb8888

可以了,谢谢!
但是能不能在直线,圆角,倒角的坐标前,作一个标识,来标识是线或是圆呢?