LAB302
từng bước vững vàng, mở lối tương lai
TRANG CHỦ
Liên hệ
ĐĂNG NHẬP
UPLINK ESTABLISHED // Autodesk > App script
REC_20250829_admin

iLogic tự động lấy tên sheet idw chuyển thành ký hiệu bản vẽ và mô tả

DATA_CORE_READY
  1. LẤY KÝ HIỆU VÀ MÔ TẢ TỪ TÊN SHEET
    Code này chỉ áp dụng cho việc xuất bản vẽ trong inventor.
    Ví dụ: Sheet có tên là "00.00.00-Hình chung" thì sẽ split '-' nên chuỗi sẽ trở thành mảng có 2 phần tử đó là: "00.00.00" và 'Hình chung'.
Dim sheetName As String
Dim parts() As String
Dim sheetCode As String = ""
Dim sheetDesc As String = ""

' Lấy tên sheet hiện tại
sheetName = ThisDrawing.ActiveSheet.Name

' Tách chuỗi theo dấu "-"
parts = Split(sheetName, "-")

' Kiểm tra xem có đủ 2 phần không
If parts.Length >= 2 Then
    sheetCode = parts(0).Trim()
    sheetDesc = parts(1).Trim()
    
    ' Loại bỏ phần ":số" ở cuối SheetDesc nếu có
    Dim colonIndex As Integer = sheetDesc.LastIndexOf(":")
    If colonIndex > 0 Then
        Dim afterColon As String = sheetDesc.Substring(colonIndex + 1).Trim()
        ' Kiểm tra xem phần sau dấu ":" có phải là số không
        Dim tempNumber As Integer
        If Integer.TryParse(afterColon, tempNumber) Then
            sheetDesc = sheetDesc.Substring(0, colonIndex).Trim()
        End If
    End If
    
Else
    sheetCode = sheetName.Trim()
    sheetDesc = ""
End If

' Gán giá trị vào Custom Properties
iProperties.Value("Custom", "SheetCode") = sheetCode
iProperties.Value("Custom", "SheetDesc") = sheetDesc

' Cập nhật document
ThisApplication.ActiveDocument.Update()

' Hiển thị kết quả
MessageBox.Show("Sheet Code: " & sheetCode & vbCrLf & "Sheet Description: " & sheetDesc, "Result")
  1. XUẤT BẢN VẼ HÀNG LOẠT DƯỚI DẠNG PDF VÀ DWG :
    Sử dụng API của Inventor: TranslatorAddIn6 - pdf và TranslatorAddIn2 - dwg
Imports System.Windows.Forms
Imports System.IO

Sub Main()
    ' Chọn tính năng xuất
    Dim choice As String = InputBox("Chọn tính năng:" & vbCrLf & _
                                  "1 - Xuất bản vẽ với định dạng PDF" & vbCrLf & _
                                  "2 - Xuất bản vẽ với định dạng AutoCAD DWG" & vbCrLf & _
                                  "Nhập 1 hoặc 2:", "Xuất bản vẽ", "1")
    If choice = "" Then Exit Sub ' User cancelled
   
    Dim exportPDF As Boolean = (choice = "1")
    Dim exportDWG As Boolean = (choice = "2")
   
    If Not exportPDF And Not exportDWG Then
        MessageBox.Show("Lựa chọn không hợp lệ!")
        Exit Sub
    End If
   
    Dim outputPath As String = ""
    Dim resolution As String = ""
    Dim dwgVersion As String = ""
    Dim strIniFile As String = "P:\_auto-test\conf.ini" ' Mặc định file .ini
   
    ' Yêu cầu thông tin bổ sung dựa trên lựa chọn
    If exportPDF Then
        resolution = InputBox("Chọn độ phân giải (150/200/300/400/600/720/1200/2400/4800):", "Xuất bản vẽ với định dạng PDF", "1200")
        If resolution = "" OrElse Not {"150", "200", "300", "400", "600", "720", "1200", "2400", "4800"}.Contains(resolution) Then
            MessageBox.Show("Độ phân giải không hợp lệ! Vui lòng chọn từ danh sách.")
            Exit Sub
        End If
        outputPath = InputBox("Nhập đường dẫn thư mục để lưu file:", "Xuất bản vẽ với định dạng PDF", "P:\_auto-test\pdf\")
    ElseIf exportDWG Then
        dwgVersion = InputBox("Chọn phiên bản AutoCAD DWG (2010/2013/2018):", "Xuất bản vẽ với định dạng AutoCAD DWG", "2013")
        If dwgVersion = "" OrElse Not {"2010", "2013", "2018"}.Contains(dwgVersion) Then
            MessageBox.Show("Phiên bản DWG không hợp lệ! Vui lòng chọn từ danh sách.")
            Exit Sub
        End If
        strIniFile = InputBox("Nhập đường dẫn file .ini (mặc định: P:\_auto-test\conf.ini, đảm bảo có 'ALL SHEETS=No'):", "Xuất bản vẽ với định dạng AutoCAD DWG", "P:\_auto-test\conf.ini")
        If strIniFile = "" Then Exit Sub ' User cancelled
        outputPath = InputBox("Nhập đường dẫn thư mục để lưu file:", "Xuất bản vẽ với định dạng AutoCAD DWG", "P:\_auto-test\cad\")
    End If
   
    If outputPath = "" Then Exit Sub ' User cancelled
    If Not outputPath.EndsWith("\") Then outputPath = outputPath & "\"
   
    ' Tạo thư mục nếu chưa tồn tại
    If Not System.IO.Directory.Exists(outputPath) Then
        System.IO.Directory.CreateDirectory(outputPath)
    End If
   
    ' Lấy document hiện tại
    Dim drawDoc As DrawingDocument = ThisApplication.ActiveDocument
   
    ' Lưu sheet hiện tại để có thể quay lại
    Dim originalSheet As Sheet = drawDoc.ActiveSheet
   
    ' Đếm số sheet và log tên sheet
    Dim totalSheets As Integer = drawDoc.Sheets.Count
    Dim sheetNames As String = "Danh sách sheet:" & vbCrLf
    For Each sheet As Sheet In drawDoc.Sheets
        sheetNames = sheetNames & Sheet.Name & vbCrLf
    Next
    MessageBox.Show("Tổng số sheet: " & totalSheets & vbCrLf & sheetNames, "Thông tin sheet")
   
    Dim processedSheets As Integer = 0
    Dim exportedIdentifiers As New List(Of String) ' Chỉ dùng cho DWG để phát hiện trùng lặp
   
    Try
        ' Duyệt qua từng sheet
        For Each sheet As Sheet In drawDoc.Sheets
            ' Activate sheet hiện tại
            Sheet.Activate()
           
            ' Cập nhật Custom Properties cho sheet hiện tại
            UpdateSheetProperties(Sheet.Name)
           
            ' Cập nhật document
            drawDoc.Update()
           
            ' Tạo tên file từ sheet name
            Dim fileName As String = GetSafeFileName(Sheet.Name)
           
            If exportPDF Then
                ' Export PDF tự động
                ExportToPDF(drawDoc, outputPath, fileName, resolution)
            ElseIf exportDWG Then
                Dim dwgPath As String = outputPath & fileName & ".dwg"
               
                ' Split filename để lấy unique identifier
                Dim parts() As String = fileName.Split("_"c)
                Dim uniqueIdentifier As String = ""
                If parts.Length >= 3 Then
                    uniqueIdentifier = parts(0) & "_" & parts(1) ' e.g., "00.00_1"
                Else
                    uniqueIdentifier = fileName ' Fallback
                End If
               
                ' Kiểm tra trùng lặp
                If exportedIdentifiers.Contains(uniqueIdentifier) Then
                    MessageBox.Show("Tệp DWG đã tồn tại cho sheet với mã: " & uniqueIdentifier & vbCrLf & "Sheet: " & Sheet.Name, "Cảnh báo trùng lặp - Bỏ qua")
                    Continue For
                End If
               
                ' Export DWG
                ExportToDWG(drawDoc, outputPath, fileName, dwgVersion, strIniFile)
               
                ' Thêm vào list
                exportedIdentifiers.Add(uniqueIdentifier)
            End If
           
            processedSheets = processedSheets + 1
           
            ' Hiển thị tiến độ
            ThisApplication.StatusBarText = "Đang xử lý sheet " & processedSheets & "/" & totalSheets & ": " & Sheet.Name
        Next
       
        ' Quay lại sheet ban đầu
        originalSheet.Activate()
       
        ' Hiển thị thông báo hoàn thành
        Dim exportedFilesList As String = ""
        If exportDWG Then
            exportedFilesList = "Các tệp DWG đã xuất (mã duy nhất):" & vbCrLf & String.Join(vbCrLf, exportedIdentifiers)
        End If
        If exportPDF Then
            MessageBox.Show("Đã hoàn thành xuất " & totalSheets & " sheet thành PDF!" & vbCrLf & _
                           "Đường dẫn: " & outputPath, "Xuất bản vẽ với định dạng PDF")
        Else
            MessageBox.Show("Đã hoàn thành xuất " & processedSheets & " sheet thành DWG!" & vbCrLf & _
                           "Đường dẫn: " & outputPath & vbCrLf & exportedFilesList, "Xuất bản vẽ với định dạng AutoCAD DWG")
        End If
    Catch ex As Exception
        MessageBox.Show("Lỗi: " & ex.Message, "Lỗi")
    Finally
        ' Xóa thông báo trạng thái
        ThisApplication.StatusBarText = ""
    End Try
End Sub

' Hàm cập nhật Custom Properties cho sheet
Sub UpdateSheetProperties(sheetName As String)
    Dim parts() As String
    Dim sheetCode As String = ""
    Dim sheetDesc As String = ""
   
    ' Tách chuỗi theo dấu "-"
    parts = Split(sheetName, "-")
   
    ' Kiểm tra xem có đủ 2 phần không
    If parts.Length >= 2 Then
        sheetCode = parts(0).Trim()
        sheetDesc = parts(1).Trim()
       
        ' Loại bỏ phần ":số" ở cuối SheetDesc nếu có
        Dim colonIndex As Integer = sheetDesc.LastIndexOf(":")
        If colonIndex > 0 Then
            Dim afterColon As String = sheetDesc.Substring(colonIndex + 1).Trim()
            ' Kiểm tra xem phần sau dấu ":" có phải là số không
            Dim tempNumber As Integer
            If Integer.TryParse(afterColon, tempNumber) Then
                sheetDesc = sheetDesc.Substring(0, colonIndex).Trim()
            End If
        End If
    Else
        sheetCode = sheetName.Trim()
        sheetDesc = ""
    End If
   
    ' Gán giá trị vào Custom Properties
    iProperties.Value("Custom", "SheetCode") = sheetCode
    iProperties.Value("Custom", "SheetDesc") = sheetDesc
End Sub

' Hàm tạo tên file an toàn (loại bỏ ký tự không hợp lệ)
Function GetSafeFileName(fileName As String) As String
    Dim invalidChars() As Char = IO.Path.GetInvalidFileNameChars()
    For Each invalidChar As Char In invalidChars
        fileName = fileName.Replace(invalidChar, "_")
    Next
    Return fileName
End Function

' Hàm export PDF sử dụng PDF Translator Add-In
Sub ExportToPDF(drawDoc As DrawingDocument, outputPath As String, fileName As String, resolution As String)
    Try
        Dim pdfPath As String = outputPath & fileName & ".pdf"
       
        ' Tìm PDF Add-In
        Dim pdfAddIn As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
       
        If pdfAddIn IsNot Nothing Then
            Dim context As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
            context.Type = IOMechanismEnum.kFileBrowseIOMechanism
           
            Dim options As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
           
            ' Check whether the translator has 'SaveCopyAs' options
            If pdfAddIn.HasSaveCopyAsOptions(drawDoc, context, options) Then
                ' Options for drawings...
                options.Value("All_Color_AS_Black") = 0
                options.Value("Remove_Line_Weights") = 0
                options.Value("Vector_Resolution") = Integer.Parse(resolution)
                options.Value("Sheet_Range") = PrintRangeEnum.kPrintCurrentSheet
                options.Value("Custom_Begin_Sheet") = 0
                options.Value("Custom_End_Sheet") = 0
                options.Value("Include_Dimensions") = 0
                options.Value("Include_Notes") = 0
                options.Value("Include_Borders") = 0
            End If
           
            Dim dataMedium As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
            dataMedium.FileName = pdfPath
           
            ' Publish document
            pdfAddIn.SaveCopyAs(drawDoc, context, options, dataMedium)
        Else
            MessageBox.Show("Không tìm thấy PDF Add-In!", "Lỗi")
        End If
       
    Catch ex As Exception
        MessageBox.Show("Lỗi khi xuất PDF cho sheet: " & fileName & vbCrLf & _
                       "Lỗi: " & ex.Message, "Lỗi PDF")
    End Try
End Sub

' Hàm export DWG sử dụng INI file
Sub ExportToDWG(drawDoc As DrawingDocument, outputPath As String, fileName As String, dwgVersion As String, strIniFile As String)
    Try
        Dim dwgPath As String = outputPath & fileName & ".dwg"
       
        ' Tìm DWG Add-In
        Dim dwgAddIn As TranslatorAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")
       
        If dwgAddIn IsNot Nothing Then
            Dim context As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
            context.Type = IOMechanismEnum.kFileBrowseIOMechanism
           
            Dim options As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
           
            ' Check whether the translator has 'SaveCopyAs' options
            If dwgAddIn.HasSaveCopyAsOptions(drawDoc, context, options) Then
                options.Value("Export_Acad_IniFile") = strIniFile ' Sử dụng file INI
                options.Value("Export_Acad_Version") = dwgVersion ' Override phiên bản nếu cần
                options.Value("AllSheets") = "No" ' Đảm bảo chỉ xuất sheet hiện tại
                options.Value("Sheet_Range") = PrintRangeEnum.kPrintCurrentSheet ' Safeguard thêm
            End If
           
            Dim dataMedium As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
            dataMedium.FileName = dwgPath
           
            ' Export document
            dwgAddIn.SaveCopyAs(drawDoc, context, options, dataMedium)
        Else
            MessageBox.Show("Không tìm thấy DWG Add-In!", "Lỗi")
        End If
       
    Catch ex As Exception
        MessageBox.Show("Lỗi khi xuất DWG cho sheet " & fileName & ": " & ex.Message, "Lỗi DWG")
    End Try
End Sub
MODULE_TAGS:
inventorilogic
lisp tạo thước đo góc
Các lệnh cad cơ bản cho người mới bắt đầu
Chuyên mục