[VBA程序]：用vba实现连续旋转复制

min_zxm

程序清单：
Sub copyAndRotate()

Dim ssetObj As AcadSelectionSet
Dim ent As AcadEntity
Dim i As Integer
Dim n As Integer



'新建选择集
On Error Resume Next
    ThisDrawing.SelectionSets("New_SelectionSet").Delete
    Set ssetObj = ThisDrawing.SelectionSets.Add("New_SelectionSet")


'检查选择集是否为空，是则退出程序
    ssetObj.SelectOnScreen
    n = ThisDrawing.SelectionSets("New_SelectionSet").Count
    If n = 0 Then
        Exit Sub
    End If


'确定目标点
Dim p1 As Variant
Dim p2 As Variant
Dim k As Double
Dim angle1 As Double
Dim angle2 As Double
Dim angle As Double
p1 = ThisDrawing.Utility.GetPoint(, "请选择旋转中心:")
p2 = ThisDrawing.Utility.GetPoint(p1, "请选择基点:")
k = (p2(1) - p1(1)) / (p2(0) - p1(0))
'MsgBox "k=" & k
'除数为零，k＝无穷大
If Err = 11 Then
     If p2(1) < p1(1) Then
     angle1 = 1.5 * 3.14159265358979
     Else
         angle1 = 0.5 * 3.14159265358979
     End If
End If
angle1 = Atn(k)
'p2在第二、三象限
If p2(0) < p1(0) Then
     angle1 = angle1 + 3.14159265358979
End If


Dim icount As Integer


While incount < 1000
'如果异常发生，退出程序
  If Err <> 0 Then
      Exit Sub
  Else
    p2 = ThisDrawing.Utility.GetPoint(p1, "请选择目标点:")
    k = (p2(1) - p1(1)) / (p2(0) - p1(0))
   
'除数为零，k＝无穷大
If Err = 11 Then
     If p2(1) < p1(1) Then
     angle2 = 1.5 * 3.14159265358979
     Else
         angle2 = 0.5 * 3.14159265358979
     End If
  End If
angle2 = Atn(k)
'p2在第二、三象限
If p2(0) < p1(0) Then
     angle2 = angle2 + 3.14159265358979
End If
   
    angle = angle2 - angle1
   
     For i = 0 To n - 1
          Set ent = ssetObj.Item(i).Copy
          ent.Rotate p1, angle
     Next
     
  End If
   
Wend

End Sub

kevinkkk

vba功能众多，作为二次开发不失为一种快速有效的方法，但还是推荐采用ARX。

butterflydml

什么东东啊。。怎么一个也不认识

liwenlongtea

能在中EXCEL运行使用吗

min_zxm

不能吧，我不知道。

YXJ1666

还没试用,先下载!
不过要谢谢你!

希望多交流,多提供这样的代码

jql7723

构思不错，不过好像用的少

li_03319

我怎么看不懂啊？看来要学一下VBA了

jebast

怎么使这项功能用于EXCEL

ssuuyyii

我还是喜欢VBA，ARX虽然功能强大，但是有VBA也就够用了。但是VBA的兼容性能比ARX好多了。你说CAD这么多版本，用ARX的话，你一个一个版本的编译，搞多了，自己都搞混了。
今年总算出了一本关于ARX的书了，《AutoCAD VBA开发精彩实例教程》虽然我看好多例子都是来自台湾的一个网站和CAD的帮助文件。（http://www.autocad.com.tw/cad-vb ... �有了本书了。

jsdyzy

怎么没了？
我正在找！！！那位大虾指点一下，让我找到VBA

neal_wang

vba真实好东西！

tandyjan

为什么不直接贴出程序！！！？？

zangben

学习雷锋好榜样   谢谢啊

于是乎

太复杂了