注册 登录
编程论坛 VB6论坛

关于VB在CAD上画图的问题,求昨天的大神师傅解答~~~

孙东东007 发布于 2015-05-22 11:50, 1823 次点击
Dim AcadApp As AcadApplication

Private Sub Command1_Click()
Dim circleObj As AcadCircle
Dim centerpoint(0 To 2) As Double
Dim radius As Double
centerpoint(0) = 0: centerpoint(1) = 0: centerpoint(2) = 0
radius = Val(Text1.Text) / 2
Set circleObj = AcadApp.ActiveDocument.ModelSpace.AddCircle(centerpoint, radius)
ZoomAll
centerpoint(0) = 0: centerpoint(1) = 0: centerpoint(2) = 0
radius = Val(Text2.Text) / 2
Set circleObj = AcadApp.ActiveDocument.ModelSpace.AddCircle(centerpoint, radius)
ZoomAll
Dim lineObj As AcadLine
Dim Startpoint(0 To 2) As Double
Dim Endpoint(0 To 2) As Double
Startpoint(0) = 600: Startpoint(1) = 0: Startpoint(2) = 0
Endpoint(0) = 600: Endpoint(1) = Val(Text1.Text) / 2: Endpoint(2) = 0:
Set lineObj = AcadApp.ActiveDocument.ModelSpace.AddLine(Startpoint, Endpoint)
ZoomAll
Startpoint(0) = 600: Startpoint(1) = Val(Text1.Text) / 2: Startpoint(2) = 0
Endpoint(0) = 600 + Val(Text5.Text): Endpoint(1) = Val(Text1.Text) / 2: Endpoint(2) = 0:
Set lineObj = AcadApp.ActiveDocument.ModelSpace.AddLine(Startpoint, Endpoint)
ZoomAll
Startpoint(0) = 600 + Val(Text5.Text): Endpoint(1) = Val(Text1.Text) / 2: Endpoint(2) = 0:
Endpoint(0) = 600 + Val(Text5.Text): Endpoint(1) = -Val(Text1.Text) / 2: Endpoint(2) = 0:
Set lineObj = AcadApp.ActiveDocument.ModelSpace.AddLine(Startpoint, Endpoint)
ZoomAll
Startpoint(0) = 600: Startpoint(1) = 0: Startpoint(2) = 0
Endpoint(0) = 600: Endpoint(1) = -Val(Text1.Text) / 2: Endpoint(2) = 0:
Set lineObj = AcadApp.ActiveDocument.ModelSpace.AddLine(Startpoint, Endpoint)
ZoomAll
Startpoint(0) = 600: Endpoint(1) = -Val(Text1.Text) / 2: Endpoint(2) = 0:
Endpoint(0) = 600 + Val(Text5.Text): Endpoint(1) = -Val(Text1.Text) / 2: Endpoint(2) = 0:
Set lineObj = AcadApp.ActiveDocument.ModelSpace.AddLine(Startpoint, Endpoint)
ZoomAll
End Sub

Private Sub Form_Load()
On Error Resume Next
Set AcadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set AcadApp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox ("不能运行AutoCAD 2007,请检查是否安装了AutoCAD 2007")
Exit Sub
End If
End If
AcadApp.Visible = True
End Sub
有点长,请耐心看看
12 回复
#2
lianyicq2015-05-22 11:56
记得描述问题
#3
孙东东0072015-05-22 12:01
好嘞,嘿嘿,谢谢师傅,,,,,这样的,,我想画一个矩形,但是在画最后一条线的时候怎么都画不上,坐标没问题,画的线总是和我画那个矩形的起始画点连接
#4
孙东东0072015-05-22 12:05
只有本站会员才能查看附件,请 登录
#5
lianyicq2015-05-22 12:07
回复 3楼 孙东东007
Startpoint(0) = 600 + Val(Text5.Text): Endpoint(1) = Val(Text1.Text) / 2: Endpoint(2) = 0:
Endpoint(0) = 600 + Val(Text5.Text): Endpoint(1) = -Val(Text1.Text) / 2: Endpoint(2) = 0:
Set lineObj = AcadApp.ActiveDocument.ModelSpace.AddLine(Startpoint, Endpoint)
ZoomAll
Startpoint(0) = 600: Startpoint(1) = 0: Startpoint(2) = 0
Endpoint(0) = 600: Endpoint(1) = -Val(Text1.Text) / 2: Endpoint(2) = 0:
Set lineObj = AcadApp.ActiveDocument.ModelSpace.AddLine(Startpoint, Endpoint)
ZoomAll
Startpoint(0) = 600: Endpoint(1) = -Val(Text1.Text) / 2: Endpoint(2) = 0:
Endpoint(0) = 600 + Val(Text5.Text): Endpoint(1) = -Val(Text1.Text) / 2: Endpoint(2) = 0:
Set lineObj = AcadApp.ActiveDocument.ModelSpace.AddLine(Startpoint, Endpoint)
ZoomAll
End Sub
仔细一些,自己检查不出来?你看红色部分不是startpoint而是endpoint
#6
孙东东0072015-05-22 12:18
师傅,你没听明白我的意思,我的控件布置界面是这样的
只有本站会员才能查看附件,请 登录
然后就开始画
只有本站会员才能查看附件,请 登录
上面有我画的顺序,矩形下面红色那部分是我想画的那条线
#7
孙东东0072015-05-22 12:20
只有本站会员才能查看附件,请 登录
#8
孙东东0072015-05-22 12:23
只有本站会员才能查看附件,请 登录
这是我想要的
#9
孙东东0072015-05-22 12:35
师傅,求你帮我看看吧,谢谢啦
#10
lianyicq2015-05-22 12:49
给你说了代码红色的地方有问题
endpoint 改为startpoint

#11
孙东东0072015-05-22 13:43
我也是服了我自己了~~~~~我也是醉了,,,不过师傅,我还有个问题不会还想让你帮我解答一下~~~~
只有本站会员才能查看附件,请 登录
这个计算结果明显是错误的,可是代码也正确啊,是精确度有问题么?应该怎么弄呢?
#12
孙东东0072015-05-22 13:44
Private Sub Command1_Click()
D = Val(Text7.Text)
P0 = 1.18 / D ^ 0.5
Text4.Text = P0
End Sub

Private Sub Command2_Click()
Text4.Text = ""
Text7.Text = ""
End Sub
#13
cuituo2023-10-30 20:10
没错误 是text4长度短,科学计数法显示不全
1