Chuyển đến nội dung
Diễn đàn CADViet

bisok2

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    6

  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi bisok2

  1. Đã đăng · Trả lời báo cáo

    bài trước em thiếu một modun em xin phép bổ sung

    ====================================================

    Public Sub MoCSDL(strDBName As Database, strFileName As String)

    On Error GoTo ErrorHandler:

    ' blnKetThuc = False

    If strFileName = "" Then

    ' blnKetThuc = True

    MsgBox "Nhap lai duong dan File du lieu", vbCritical

    Exit Sub

    End If

    Set strDBName = OpenDatabase(strFileName)

    Exit Sub

    ErrorHandler:

    MsgBox "Kh«ng më ®­îc CSDL! Chän l¹i File MDB !" & Err.Description

    ' blnKetThuc = True

    Exit Sub

    End Sub

    ==================================================

  3. Đã đăng · Trả lời báo cáo

    Em đang học về VBA trong autoCAD nhưng đến phần CSDL thì thấy mắc quá. Bác nào giúp em doạn code tạo 1 file diem.MDB sau đó nhập tọa độ của 1 điểm gồm X và Y(tu 1file .txt), sau đó truy xuất từ file diem.MDB đó vẽ trên autocad với ạ

    Cảm ơn các bác nhiều!

    Mình cũng tập tành làm việc với VBA trong cad. sau đây là đoạn code về đọc dữ liệu từ file MDB và vẽ lại trong CAD của mình

    đây là ứng dụng cụ thể về việc đọc 1 file MDB được export từ chương trình Sap 8.203

    đầu tiên là modun về tạo FileDialog để mở file MDB (cái này do mình ko đủ ocx để tạo commondialog nên phài nhờ ông anh làm hộ :s_big: )

    =======================

    Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

    Public Type OPENFILENAME

    lStructSize As Long

    hwndOwner As Long

    hInstance As Long

    lpstrFilter As String

    lpstrCustomFilter As String

    nMaxCustFilter As Long

    nFilterIndex As Long

    lpstrFile As String

    nMaxFile As Long

    lpstrFileTitle As String

    nMaxFileTitle As Long

    lpstrInitialDir As String

    lpstrTitle As String

    flags As Long

    nFileOffset As Integer

    nFileExtension As Integer

    lpstrDefExt As String

    lCustData As Long

    lpfnHook As Long

    lpTemplateName As String

    End Type

    Public Function SelectFileDialog(ByVal isOpen, ByVal FileFilter, ByVal initDir)

    Dim strTemp, strTemp1, pathStr As String

    Dim I, n, J As Long

    Dim OpenFile As OPENFILENAME

    Dim lReturn As Long

    Dim sFilter As String

    Dim Fname As String

    OpenFile.lStructSize = Len(OpenFile)

    If FileFilter = "" Then

    sFilter = "Text Files (*.txt)" & Chr(0) & "*.TXT" & Chr(0)

    Else

    sFilter = FileFilter

    End If

    If FileFilter = "" Then

    OpenFile.lpstrInitialDir = initDir

    Else

    OpenFile.lpstrInitialDir = "d:\"

    End If

    If isOpen = True Then

    OpenFile.lpstrTitle = "Open"

    Else

    OpenFile.lpstrTitle = "Save"

    End If

     

    OpenFile.lpstrFilter = sFilter

    OpenFile.nFilterIndex = 1

    OpenFile.lpstrFile = String(257, 0)

    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1

    OpenFile.lpstrFileTitle = OpenFile.lpstrFile

    OpenFile.nMaxFileTitle = OpenFile.nMaxFile

    OpenFile.flags = 0

    lReturn = GetOpenFileName(OpenFile)

    If lReturn = 0 Then

    SelectFileDialog = ""

    Else

    SelectFileDialog = Trim(OpenFile.lpstrFile)

    End If

    End Function

    ===========================

    tiếp theo là modun vẽ

    ============

    Public Sub Ve3DThap()

    Dim strSQL

    Dim Line As Variant

    Dim SP As Variant, EP As Variant

    Dim StartPoint(0 To 2) As Double

    Dim EndPoint(0 To 2) As Double

    Dim bytSoDotCu As Byte

    Dim DBKT As Database

    Dim RS As Recordset, RS1 As Recordset

    Dim bytI As Byte

    Dim intSoThanhCu, intSoThanhMoi

    Dim CaoTrinh As Double

    Dim SQL As String

    Dim fileName As String

    fileName = SelectFileDialog(True, "Data Files (*.mdb)" & Chr(0) & "*.mdb" & Chr(0), "D:")

    If Not (fileName = "") Then

    Call MoCSDL(DBKT, Trim(fileName))

    'Doc du lieu tu bang [Connectivity - Frame/Cable]

    strSQL = "SELECT Fr.Frame, JC1.XorR as XorR1, JC1.Y as Y1 , JC1.Z as Z1, JC2.XorR AS XorR2, JC2.Y as Y2 , JC2.Z as Z2 " & _

    "FROM ([Connectivity - Frame/Cable] AS Fr INNER JOIN [Joint Coordinates] AS JC1 ON Fr.JointI = JC1.Joint) " & _

    "INNER JOIN [Joint Coordinates] AS JC2 ON Fr.JointJ = JC2.Joint"

    Set RS = DBKT.OpenRecordset(strSQL)

    RS.MoveFirst

    Do While Not RS.EOF

    StartPoint(0) = RS.Fields("XorR1")

    StartPoint(1) = RS.Fields("Y1")

    StartPoint(2) = RS.Fields("Z1")

    EndPoint(0) = RS.Fields("XorR2")

    EndPoint(1) = RS.Fields("Y2")

    EndPoint(2) = RS.Fields("Z2")

    Set Line = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint)

    RS.MoveNext

    Loop

    '§ãng RS më bëi c©u truy vÊn strSQL

    RS.Close

    Else

    MsgBox "Chon Lai Duong Dan File Du Lieu"

    End If

    End Sub

    Mình sẽ up file mdb cho bạn tiện sử dụng

  4. Đã đăng · Trả lời báo cáo

    Cảm ơn bạn rất nhiều đã chia sẻ kinh nghiệm! mình rất thích làm những ứng dụng như thế này nhưng vì kiến thức về lập trình quá nông cạn nên không thể làm nổi nếu có điều kiện mong bạn chỉ dạy thêm

    nhân đây mình muốn hỏi có cách nào để đọc hoặc ghi một file định dạng MDB trong VBA của ACAD được không? xin cảm ơn bạn trước :) :)

×