| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1823 人关注过本帖
标题:关于VB在CAD上画图的问题,求昨天的大神师傅解答~~~
只看楼主 加入收藏
孙东东007
Rank: 1
等 级:新手上路
帖 子:45
专家分:0
注 册:2015-4-9
结帖率:77.78%
收藏
已结贴  问题点数:20 回复次数:12 
关于VB在CAD上画图的问题,求昨天的大神师傅解答~~~
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
有点长,请耐心看看
2015-05-22 11:50
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:10 
记得描述问题

大开眼界
2015-05-22 11:56
孙东东007
Rank: 1
等 级:新手上路
帖 子:45
专家分:0
注 册:2015-4-9
收藏
得分:0 
好嘞,嘿嘿,谢谢师傅,,,,,这样的,,我想画一个矩形,但是在画最后一条线的时候怎么都画不上,坐标没问题,画的线总是和我画那个矩形的起始画点连接
2015-05-22 12:01
孙东东007
Rank: 1
等 级:新手上路
帖 子:45
专家分:0
注 册:2015-4-9
收藏
得分:0 
图片附件: 游客没有浏览图片的权限,请 登录注册
2015-05-22 12:05
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:5 
回复 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

大开眼界
2015-05-22 12:07
孙东东007
Rank: 1
等 级:新手上路
帖 子:45
专家分:0
注 册:2015-4-9
收藏
得分:0 
师傅,你没听明白我的意思,我的控件布置界面是这样的
图片附件: 游客没有浏览图片的权限,请 登录注册
然后就开始画
图片附件: 游客没有浏览图片的权限,请 登录注册
上面有我画的顺序,矩形下面红色那部分是我想画的那条线
2015-05-22 12:18
孙东东007
Rank: 1
等 级:新手上路
帖 子:45
专家分:0
注 册:2015-4-9
收藏
得分:0 
图片附件: 游客没有浏览图片的权限,请 登录注册
2015-05-22 12:20
孙东东007
Rank: 1
等 级:新手上路
帖 子:45
专家分:0
注 册:2015-4-9
收藏
得分:0 
图片附件: 游客没有浏览图片的权限,请 登录注册
这是我想要的
2015-05-22 12:23
孙东东007
Rank: 1
等 级:新手上路
帖 子:45
专家分:0
注 册:2015-4-9
收藏
得分:0 
师傅,求你帮我看看吧,谢谢啦
2015-05-22 12:35
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:5 
给你说了代码红色的地方有问题
endpoint 改为startpoint


大开眼界
2015-05-22 12:49
快速回复:关于VB在CAD上画图的问题,求昨天的大神师傅解答~~~
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.035551 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved