在CorelDraw中用VB.NET2003实现自动投井

'----------------------------------------------------------------------------- '绘图坐标原点（183.83，181.81） '对应高斯坐标（20550000.00 4300000.00） 'WName = rest.Fields(1).Value 'LocX = rest.Fields(2).Value 'LocY = rest.Fields(3).Value 'Status=rest.Fields(4).Value 'Stratathick = rest.Fields(5).Value 'Sandthick = rest.Fields(6).Value 'Sandrate = rest.Fields(7).Value Sub 井数据导入() ' ' Recorded 2008-10-30 ' ' Description: ' 功能VBA描述 'ADODB使用前需引用microsoft activex data object 2.x library '------------------------------------------- ActiveDocument.Unit = cdrMillimeter ActiveDocument.ReferencePoint = cdrCenter Dim WName As String Dim Count, LocX, LocY, posX, posY As Double Dim Status, Stratathick, Sandthick, Sandrate As String Dim ConnectStr, sqlStr As String Dim I As Integer Dim MyConn As ADODB.Connection Dim rest, text As ADODB.Recordset Dim Left, Top, Right, Bottom As Double Dim sh_name, sh_data As Shape '---------------------------------打开数据库 ConnectStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "井数据表格.xls;" & "Extended Properties=Excel 8.0;" Set MyConn = New ADODB.Connection Set rest = New ADODB.Recordset MyConn.Open ConnectStr '--------------------------------返回成员个数 'MyConn.CursorLocation = adUseClient 'rest.Open "select * from [井数据$]", MyConn, adOpenKeyset, adLockReadOnly 'rest.MoveLast 'rest.MoveFirst Count = 2 '输入井数据个数=行数-1 rest.RecordCount 'MsgBox (Count) '-------------------------循环 'text.CursorLocation = adUseClient sqlStr = "SELECT * from [井数据$]" Set rest = MyConn.Execute(sqlStr) '--------------------------------------创建图层 ActivePage.CreateLayer "井位" ActivePage.CreateLayer "井名" ActivePage.CreateLayer "地层厚度" ActivePage.CreateLayer "砂岩厚度" ActivePage.CreateLayer "砂岩含量比" '---------------------------------------输入井位 ActivePage.Layers("图例").Activate ActiveLayer.Shapes.All.Copy rest.MoveFirst For I = 1 To Count ActivePage.Layers("井位").Activate ActiveLayer.Paste Next I ActiveLayer.Shapes.All For I = 1 To Count WName = rest.Fields(1).Value LocX = rest.Fields(2).Value LocY = rest.Fields(3).Value '输入井位 posX = 183.83 + ((LocX - 20550000#) / 100) ' + 8.87 posY = 181.81 + ((LocY - 4300000#) / 100) ' + 11.11 '绘图坐标原点（183.83，181.81） '对应高斯坐标（20550000.00 4300000.00） ActiveLayer.Shapes(I).SetPosition posX, posY rest.MoveNext Next I '---------------------------------------输入井名 rest.MoveFirst 'Dim Left, Top, Right, Bottom As Double 'Dim sh_name As Shape For I = 1 To Count ActivePage.Layers("井名").Activate WName = rest.Fields(1).Value LocX = rest.Fields(2).Value LocY = rest.Fields(3).Value '输入井位 posX = 183.83 + ((LocX - 20550000#) / 100) '+ 8.87 posY = 181.81 + ((LocY - 4300000#) / 100) - 3.6 '+ 11.11 Left = 0 Bottom = 0 'Set sh_name = ActiveLayer.CreateParagraphText(Left, Top, Right, Bottom, WName, LanguageID = cdrLanguageNone, CharSet = cdrCharSetMixed, "宋体", 10) 'CreateParagraphText(Left As Double, Top As Double, Right As Double, Bottom As Double, [Text As String], [LanguageID As cdrTextLanguage = cdrLanguageNone], [CharSet As cdrTextCharSet = cdrCharSetMixed], [Font As String], [Size As Single], [Bold As cdrTriState = cdrUndefined], [Italic As cdrTriState = cdrUndefined], [Underline As cdrFontLine = cdrMixedFontLine], [Alignment As cdrAlignment = cdrMixedAlignment]) As Shape Set sh_name = ActiveLayer.CreateArtisticText(Left, Bottom, WName, LanguageID = cdrLanguageNone, CharSet = cdrCharSetMixed, "宋体", 8) sh_name.SetPosition posX, posY rest.MoveNext 'Function CreateArtisticText(Left As Double, Bottom As Double, Text As String, [LanguageID As cdrTextLanguage = cdrLanguageNone], [CharSet As cdrTextCharSet = cdrCharSetMixed], [Font As String], [Size As Single], [Bold As cdrTriState = cdrUndefined], [Italic As cdrTriState = cdrUndefined], [Underline As cdrFontLine = cdrMixedFontLine], [Alignment As cdrAlignment = cdrMixedAlignment]) As Shape Next I '---------------------------------------输入地层厚度 rest.MoveFirst 'Dim Left, Top, Right, Bottom As Double 'Dim sh_data As Shape For I = 1 To Count ActivePage.Layers("地层厚度").Activate LocX = rest.Fields(2).Value LocY = rest.Fields(3).Value Status = rest.Fields(4).Value Stratathick = rest.Fields(5).Value If StrComp(Status, "0") = 0 Then Else Stratathick = ">" & Stratathick End If ' ' ' '输入井位 posX = 183.83 + ((LocX - 20550000#) / 100) ' + 8.87 posY = 181.81 + ((LocY - 4300000#) / 100) + 3.6 '+ 11.11 Left = -5 Top = -2.2 Right = 11 Bottom = 2.2 Set sh_data = ActiveLayer.CreateArtisticText(Left, Bottom, Stratathick, LanguageID = cdrLanguageNone, CharSet = cdrCharSetMixed, "宋体", 8) 'CreateParagraphText(Left As Double, Top As Double, Right As Double, Bottom As Double, [Text As String], [LanguageID As cdrTextLanguage = cdrLanguageNone], [CharSet As cdrTextCharSet = cdrCharSetMixed], [Font As String], [Size As Single], [Bold As cdrTriState = cdrUndefined], [Italic As cdrTriState = cdrUndefined], [Underline As cdrFontLine = cdrMixedFontLine], [Alignment As cdrAlignment = cdrMixedAlignment]) As Shape sh_data.SetPosition posX, posY rest.MoveNext Next I '---------------------------------------输入砂岩厚度 rest.MoveFirst 'Dim Left, Top, Right, Bottom As Double 'Dim sh_data As Shape For I = 1 To Count ActivePage.Layers("砂岩厚度").Activate LocX = rest.Fields(2).Value LocY = rest.Fields(3).Value Status = rest.Fields(4).Value Sandthick = rest.Fields(6).Value If StrComp(Status, "0") = 0 Then Else Sandthick = ">" & Sandthick End If '输入井位 posX = 183.83 + ((LocX - 20550000#) / 100) '+ 8.87 posY = 181.81 + ((LocY - 4300000#) / 100) + 3.6 '+ 11.11 Left = -5 Top = -2.2 Right = 11 Bottom = 2.2 Set sh_data = ActiveLayer.CreateArtisticText(Left, Bottom, Sandthick, LanguageID = cdrLanguageNone, CharSet = cdrCharSetMixed, "宋体", 8) 'CreateParagraphText(Left As Double, Top As Double, Right As Double, Bottom As Double, [Text As String], [LanguageID As cdrTextLanguage = cdrLanguageNone], [CharSet As cdrTextCharSet = cdrCharSetMixed], [Font As String], [Size As Single], [Bold As cdrTriState = cdrUndefine