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

emmacui 发表于 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编的

azjmjsj 发表于 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

emmacui 发表于 2008-3-30 21:48:00

非常感谢!!!你人真是太好了

查看完整版本: [求助]跪求好心人帮帮我这个小菜鸟,看看那里出错了