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

emmacui

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(, "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
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

帮你改了一下，已测试可成功绘制直线

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

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