|
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编的
|
|