CAD vba 子函数问题请教

发布网友发布时间：2023-04-26 02:36

共1个回答

热心网友时间：2023-10-17 18:00

你的是什麽代码呀，怎麽运行都有问题，还汲及到按扭(CommandButton1)，反正我是没办法正常运行这段代码，看你的意思，你是不是已经能进行连续两个矩形的绘制，还有一个问题，只知道对角线长度是不能绘制固定的一个矩形，所有代码存在最简单的几何问题，不过绘制正方形是可以的,除非对角线不是水平或垂直的线，矩形为水平的，这样还有可能。加入do...loop
就可以了，它会重复从Do到Loop之间的句子,你可以参考我QQ空间裏面的几段代码，我的帐号就是我的QQ号了
根据你的意思，我刚刚写了一段代码，你运行来看一下,是不是你要的那个意思呀
Dim
Var
As
Variant
Dim
Var1
As
Variant
Dim
Ln(0
To
2)
As
Double
Dim
PT1(0
To
2)
As
Double
Dim
PT2(0
To
2)
As
Double
Dim
PT3(0
To
14)
As
Double
Public
Sub
ZSYan()
On
Error
GoTo
Err
Var
=
ThisDrawing.Utility.GetPoint(,
"请指定矩形起点:
")
PT1(0)
=
Var(0)
PT1(1)
=
Var(1)
PT1(2)
=
Var(2)
Do
Var1
=
ThisDrawing.Utility.GetPoint(PT1,
"请指定矩形的对角点:
")
PT2(0)
=
Var1(0)
PT2(1)
=
Var1(1)
PT2(2)
=
Var1(2)
If
PT1(0)
=
PT2(0)
Or
PT1(1)
=
PT2(1)
Then
ThisDrawing.Utility.Prompt
vbCrLf
&
"请选取不与上一点正交的点"
&
vbCrLf
Else
PT3(0)
=
PT1(0):
PT3(1)
=
PT1(1):
PT3(2)
=
PT1(2)
PT3(3)
=
PT2(0):
PT3(4)
=
PT1(1):
PT3(5)
=
PT1(2)
PT3(6)
=
PT2(0):
PT3(7)
=
PT2(1):
PT3(8)
=
PT1(2)
PT3(9)
=
PT1(0):
PT3(10)
=
PT2(1):
PT3(11)
=
PT1(2)
PT3(12)
=
PT1(0):
PT3(13)
=
PT1(1):
PT3(14)
=
PT1(2)
ThisDrawing.ModelSpace.AddPolyline
(PT3)
Var
=
ThisDrawing.Utility.GetPoint(PT2,
"请指定矩形的对角点:
")
PT1(0)
=
Var(0)
PT1(1)
=
Var(1)
PT1(2)
=
Var(2)
If
PT1(0)
=
PT2(0)
Or
PT1(1)
=
PT2(1)
Then
ThisDrawing.Utility.Prompt
vbCrLf
&
"请选取不与上一点正交的点"
&
vbCrLf
PT1(0)
=
PT2(0)
PT1(1)
=
PT2(1)
PT1(2)
=
PT2(2)
Else
PT3(0)
=
PT1(0):
PT3(1)
=
PT1(1):
PT3(2)
=
PT1(2)
PT3(3)
=
PT2(0):
PT3(4)
=
PT1(1):
PT3(5)
=
PT1(2)
PT3(6)
=
PT2(0):
PT3(7)
=
PT2(1):
PT3(8)
=
PT1(2)
PT3(9)
=
PT1(0):
PT3(10)
=
PT2(1):
PT3(11)
=
PT1(2)
PT3(12)
=
PT1(0):
PT3(13)
=
PT1(1):
PT3(14)
=
PT1(2)
ThisDrawing.ModelSpace.AddPolyline
(PT3)
End
If
End
If
Loop
Err:
ThisDrawing.Utility.Prompt
vbCrLf
&
"*取消*"
&
vbCrLf
End
Sub