乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 41|回复: 2

[求助]跪求好心人帮帮我这个小菜鸟,看看那里出错了

[复制链接]

1

主题

2

帖子

1

银币

初来乍到

Rank: 1

铜币
6
发表于 2008-3-29 21:16:00 | 显示全部楼层 |阅读模式
Public Function AddLineXY(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double) As AcadLine
Dim pt1(2) As Double
Dim pt2(2) As Double
pt1(0) = x1: pt1(1) = y1: pt1(2) = 0
pt2(0) = x2: pt2(1) = y2: pt2(2) = 0
For i = 1 To 49
  x1 = MSFlexGrid1.TextMatrix(i, 1)
  y1 = MSFlexGrid1.TextMatrix(i, 2)
  x2 = MSFlexGrid1.TextMatrix(i + 1, 1)
  y2 = MSFlexGrid1.TextMatrix(i + 1, 1)
Next i
  
Set AddLineXY = AddLine(pt1, pt2)
End Function
Public Sub TestLine()
    Dim ptSt(0 To 2) As Double
    Dim ptEn(0 To 2) As Double
   
    ptSt(0) = 100: ptSt(1) = 100: ptSt(2) = 0
    ptEn(0) = 150: ptEn(1) = 100: ptEn(2) = 0
    '(1)
    AddLine ptSt, ptEn
   
    '(2)
    AddLineXY 100, 120, 150, 120
   
    '(3)
    AddLineReXY ptSt, 50, 50
   
    '(4)
    AddLineReAL ptSt, 3, 50
End Sub
Private Sub Command1_Click()
On Error Resume Next
Set AcadApp = GetObject(, ".Application")
If Err Then
Err.Clear
Set AcadApp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
AcadApp.WindowTop = 0
AcadApp.WindowLeft = 400
AcadApp.Width = 600
AcadApp.Height = 800
AcadApp.Visible = True
AcadApp.Documents.Add
Set AcadDoc = AcadApp.ActiveDocument
AcadDoc.WindowState = acMax
End Sub
Private Sub Form_Load()
Text1.Move -10000, -10000, 1, 1
MSFlexGrid1.Rows = 50: MSFlexGrid1.Cols = 3
s = Array("500", "1300", "1300")
y = Array("点号", "X坐标", "Y坐标")
For i = 0 To 2
  MSFlexGrid1.ColWidth(i) = s(i): MSFlexGrid1.TextMatrix(0, i) = y(i)
Next i
For i = 1 To 49
   MSFlexGrid1.TextMatrix(i, 0) = i
Next i
End Sub
Private Sub MSFlexGrid1_EnterCell()
MSFlexGrid1.CellBackColor = vbBlue
MSFlexGrid1.CellForeColor = vbWhite
Text1.Text = MSFlexGrid1.Text
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub MSFlexGrid1_LeaveCell()
MSFlexGrid1.CellBackColor = vbWhite
MSFlexGrid1.CellForeColor = vbBlue
End Sub
Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Text1.SetFocus
End Sub
Private Sub Text1_Change()
MSFlexGrid1.Text = Text1.Text
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown
KeyCode = 0
End Select
End Sub
我是用一个表格控件输入XY坐标 然后画出直线,可是CAD打开后连个点都看不到,狂郁闷中,我哪里弄错了?求好心的强人们指点?
我是用VB编的
回复

使用道具 举报

16

主题

93

帖子

5

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
157
发表于 2008-3-30 16:35:00 | 显示全部楼层
帮你改了一下,已测试可成功绘制直线
Private Sub Command1_Click()
On Error Resume Next
Set Acadapp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set Acadapp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
Acadapp.WindowTop = 0
Acadapp.WindowLeft = 400
Acadapp.Width = 600
Acadapp.Height = 800
Acadapp.Visible = True
Acadapp.Documents.Add
Set AcadDoc = Acadapp.ActiveDocument
AcadDoc.WindowState = acMax
    Dim ptSt(0 To 2) As Double
    Dim ptEn(0 To 2) As Double
    ptSt(0) = 100: ptSt(1) = 100: ptSt(2) = 0
    ptEn(0) = 150: ptEn(1) = 100: ptEn(2) = 0
    AcadDoc.ModelSpace.AddLine ptSt, ptEn
   
    Dim pt1(2) As Double
    Dim pt2(2) As Double
    For i = 1 To 49
    x1 = MSFlexGrid1.TextMatrix(i, 1)
    y1 = MSFlexGrid1.TextMatrix(i, 2)
    x2 = MSFlexGrid1.TextMatrix(i + 1, 1)
    y2 = MSFlexGrid1.TextMatrix(i + 1, 2)
    pt1(0) = x1: pt1(1) = y1: pt1(2) = 0
    pt2(0) = x2: pt2(1) = y2: pt2(2) = 0
    AcadDoc.ModelSpace.AddLine pt1, pt2
    Next i
   
Acadapp.zoomextents
End Sub
*************************************************************
西北凡人-----http://www.abofanyi.com/blog
回复

使用道具 举报

1

主题

2

帖子

1

银币

初来乍到

Rank: 1

铜币
6
发表于 2008-3-30 21:48:00 | 显示全部楼层
非常感谢!!!你人真是太好了
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-5 00:53 , Processed in 0.360584 second(s), 59 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表