[求助]跪求好心人帮帮我这个小菜鸟,看看那里出错了
<p>Public Function AddLineXY(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double) As AcadLine</p><p>Dim pt1(2) As Double<br/>Dim pt2(2) As Double<br/>pt1(0) = x1: pt1(1) = y1: pt1(2) = 0<br/>pt2(0) = x2: pt2(1) = y2: pt2(2) = 0<br/>For i = 1 To 49<br/> x1 = MSFlexGrid1.TextMatrix(i, 1)<br/> y1 = MSFlexGrid1.TextMatrix(i, 2)<br/> x2 = MSFlexGrid1.TextMatrix(i + 1, 1)<br/> y2 = MSFlexGrid1.TextMatrix(i + 1, 1)<br/>Next i<br/> <br/>Set AddLineXY = AddLine(pt1, pt2)</p><p></p><p>End Function</p><p></p><p><br/>Public Sub TestLine()<br/> Dim ptSt(0 To 2) As Double<br/> Dim ptEn(0 To 2) As Double<br/> <br/> ptSt(0) = 100: ptSt(1) = 100: ptSt(2) = 0<br/> ptEn(0) = 150: ptEn(1) = 100: ptEn(2) = 0</p><p> '(1)<br/> AddLine ptSt, ptEn<br/> <br/> '(2)<br/> AddLineXY 100, 120, 150, 120<br/> <br/> '(3)<br/> AddLineReXY ptSt, 50, 50<br/> <br/> '(4)<br/> AddLineReAL ptSt, 3, 50<br/>End Sub</p><p>Private Sub Command1_Click()<br/>On Error Resume Next<br/>Set AcadApp = GetObject(, "AutoCAD.Application")<br/>If Err Then<br/>Err.Clear<br/>Set AcadApp = CreateObject("AutoCAD.Application")<br/>If Err Then<br/>MsgBox Err.Description<br/>Exit Sub<br/>End If<br/>End If<br/>AcadApp.WindowTop = 0<br/>AcadApp.WindowLeft = 400<br/>AcadApp.Width = 600<br/>AcadApp.Height = 800<br/>AcadApp.Visible = True<br/>AcadApp.Documents.Add<br/>Set AcadDoc = AcadApp.ActiveDocument<br/>AcadDoc.WindowState = acMax<br/>End Sub</p><p>Private Sub Form_Load()<br/>Text1.Move -10000, -10000, 1, 1<br/>MSFlexGrid1.Rows = 50: MSFlexGrid1.Cols = 3<br/>s = Array("500", "1300", "1300")<br/>y = Array("点号", "X坐标", "Y坐标")<br/>For i = 0 To 2<br/> MSFlexGrid1.ColWidth(i) = s(i): MSFlexGrid1.TextMatrix(0, i) = y(i)<br/>Next i<br/>For i = 1 To 49<br/> MSFlexGrid1.TextMatrix(i, 0) = i<br/>Next i<br/>End Sub</p><p>Private Sub MSFlexGrid1_EnterCell()<br/>MSFlexGrid1.CellBackColor = vbBlue<br/>MSFlexGrid1.CellForeColor = vbWhite<br/>Text1.Text = MSFlexGrid1.Text<br/>Text1.SelStart = 0<br/>Text1.SelLength = Len(Text1.Text)<br/>End Sub</p><p>Private Sub MSFlexGrid1_LeaveCell()<br/>MSFlexGrid1.CellBackColor = vbWhite<br/>MSFlexGrid1.CellForeColor = vbBlue<br/>End Sub</p><p>Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)<br/>Text1.SetFocus<br/>End Sub</p><p>Private Sub Text1_Change()<br/>MSFlexGrid1.Text = Text1.Text<br/>End Sub</p><p>Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)<br/>Select Case KeyCode<br/>Case vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown<br/>KeyCode = 0<br/>End Select<br/>End Sub</p><p>我是用一个表格控件输入XY坐标 然后画出直线,可是CAD打开后连个点都看不到,狂郁闷中,我哪里弄错了?求好心的强人们指点?</p><p>我是用VB编的</p> <p>帮你改了一下，已测试可成功绘制直线</p><p>Private Sub Command1_Click()<br/>On Error Resume Next<br/>Set Acadapp = GetObject(, "AutoCAD.Application")<br/>If Err Then<br/>Err.Clear<br/>Set Acadapp = CreateObject("AutoCAD.Application")<br/>If Err Then<br/>MsgBox Err.Description<br/>Exit Sub<br/>End If<br/>End If<br/>Acadapp.WindowTop = 0<br/>Acadapp.WindowLeft = 400<br/>Acadapp.Width = 600<br/>Acadapp.Height = 800<br/>Acadapp.Visible = True<br/>Acadapp.Documents.Add<br/>Set AcadDoc = Acadapp.ActiveDocument<br/>AcadDoc.WindowState = acMax</p><p> Dim ptSt(0 To 2) As Double<br/> Dim ptEn(0 To 2) As Double<br/> ptSt(0) = 100: ptSt(1) = 100: ptSt(2) = 0<br/> ptEn(0) = 150: ptEn(1) = 100: ptEn(2) = 0<br/> AcadDoc.ModelSpace.AddLine ptSt, ptEn<br/> <br/> Dim pt1(2) As Double<br/> Dim pt2(2) As Double<br/> For i = 1 To 49<br/> x1 = MSFlexGrid1.TextMatrix(i, 1)<br/> y1 = MSFlexGrid1.TextMatrix(i, 2)<br/> x2 = MSFlexGrid1.TextMatrix(i + 1, 1)<br/> y2 = MSFlexGrid1.TextMatrix(i + 1, 2)<br/> pt1(0) = x1: pt1(1) = y1: pt1(2) = 0<br/> pt2(0) = x2: pt2(1) = y2: pt2(2) = 0<br/> AcadDoc.ModelSpace.AddLine pt1, pt2<br/> Next i<br/> <br/>Acadapp.zoomextents<br/>End Sub</p><p>*************************************************************</p><p>西北凡人-----http://www.abofanyi.com/blog</p> <p>非常感谢!!!你人真是太好了 </p>
页:
[1]