iLogic tự động lấy tên sheet idw chuyển thành ký hiệu bản vẽ và mô tả
Đăng nhập
Từ khóa tìm kiếm
Ảnh bìa mặc định
Avatar mặc định
nosine

Đăng nhập - Đăng ký

  • Có 12 bài viết
  • Có 0 bình luận
Autodesk App script

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

admin
admin
/ 0 Bình luận / 5 lượt xem
  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
0
inventorilogic
Người đăng: admin
URL: https://nosine.wap4.co/app-script-autodesk/ilogic-tu-dong-lay-ten-sheet-idw-chuyen-thanh-ky-hieu-ban-ve-va-mo-ta.html
Bài viết liên quan
iLogic tính một số thông số đặc trưng hình học
iLogic tính một số thông số đặc trưng hình học
 iLogic xuất tệp step hàng loạt
iLogic xuất tệp step hàng loạt

Bình luận

Admin đã tắt nhận xét trên tất cả các bài viết