inventor
(4 bài viết)
-
iLogic mở tất cả file step trong thư mục đích được chỉ định Sub Main() ' Tạo dialog chọn thư mục Dim oFolderDlg As New System.Windows.Forms.FolderBrowserDialog oFolderDlg.Description = "Chọn thư mục chứa các file STEP muốn mở" oFolderDlg.ShowNewFolderButton = False If oFolderDlg.ShowDialog() <> System.Windows.Forms.DialogResult.OK Then MessageBox.Show("Đã hủy thao tác.", "Mở file STEP", MessageBoxButtons.OK, MessageBoxIcon.Information) Return End If Dim folderPath As String = oFolderDlg.SelectedPath ' Lấy tất cả file .step và .stp trong thư mục (không lấy thư mục con) Dim stepFiles As String() = System.IO.Directory.GetFiles(folderPath, "*.step") Dim stpFiles As String() = System.IO.Directory.GetFiles(folderPath, "*.stp") ' Kết hợp hai mảng Dim allFiles As New System.Collections.ArrayList allFiles.AddRange(stepFiles) allFiles.AddRange(stpFiles) If allFiles.Count = 0 Then MessageBox.Show("Không tìm thấy file STEP nào trong thư mục:" & vbCrLf & folderPath, "Không có file", MessageBoxButtons.OK, MessageBoxIcon.Warning) Return End If ' Hỏi người dùng có muốn mở tất cả không Dim result As DialogResult = MessageBox.Show("Tìm thấy " & allFiles.Count & " file STEP." & vbCrLf & "Bạn có muốn mở tất cả không?", "Xác nhận mở file", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = DialogResult.No Then Return ' Mở từng file STEP Dim openedCount As Integer = 0 For Each filePath As String In allFiles Try ' Mở file với tùy chọn mặc định (Import STEP) Dim oDoc As Document = ThisApplication.Documents.Open(filePath, True) openedCount += 1 Catch ex As Exception MessageBox.Show("Lỗi khi mở file:" & vbCrLf & filePath & vbCrLf & vbCrLf & ex.Message, "Lỗi mở file", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try Next MessageBox.Show("Đã mở thành công " & openedCount & " / " & allFiles.Count & " file STEP.", "Hoàn tất", MessageBoxButtons.OK, MessageBoxIcon.Information) End Sub -
iLogic tự động lấy tên sheet idw chuyển thành ký hiệu bản vẽ và mô tả LẤY KÝ HIỆU VÀ MÔ TẢ TỪ TÊN SHEETCode 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")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 - dwgImports 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
-
iLogic tính một số thông số đặc trưng hình học Dim doc = ThisDoc.Document Dim oCD As ComponentDefinition = doc.ComponentDefinition Dim oCommandMgr As CommandManager = ThisApplication.CommandManager ' Chọn mặt phẳng Dim oFace As Face = oCommandMgr.Pick(SelectionFilterEnum.kPartFacePlanarFilter, "Chọn mặt phẳng phẳng") If oFace Is Nothing Then Exit Sub ' Tạo sketch trên mặt phẳng đã chọn Dim oSk As PlanarSketch = oCD.Sketches.Add(oFace) oSk.Edit() ' Thực thi lệnh ProjectCutEdgesCmd oCommandMgr.ControlDefinitions("SketchProjectCutEdgesCmd").Execute() ' Lấy profile và tính diện tích, các momen quán tính Dim oProfile As Profile = oSk.Profiles.AddForSolid Dim dArea_cm2 As Double = oProfile.RegionProperties.Area Dim adPrincipalMoments(2) As Double oProfile.RegionProperties.PrincipalMomentsOfInertia( _ adPrincipalMoments(0), _ ' Ix (Moment quán tính quanh trục X) adPrincipalMoments(1), _ ' Iy (Moment quán tính quanh trục Y) adPrincipalMoments(2)) ' Ixy (Moment quán tính chéo) ' Tìm giới hạn x và y từ các điểm sketch Dim minX As Double = Double.MaxValue Dim maxX As Double = Double.MinValue Dim minY As Double = Double.MaxValue Dim maxY As Double = Double.MinValue For Each pt As SketchPoint In oSk.SketchPoints If pt.Geometry.X < minX Then minX = pt.Geometry.X If pt.Geometry.X > maxX Then maxX = pt.Geometry.X If pt.Geometry.Y < minY Then minY = pt.Geometry.Y If pt.Geometry.Y > maxY Then maxY = pt.Geometry.Y Next ' Tính tọa độ trọng tâm (centroid) và chuyển đổi sang mm Dim centroid As Point2d = oProfile.RegionProperties.Centroid Dim cX_cm As Double = centroid.X Dim cY_cm As Double = centroid.Y Dim cX_mm As Double = cX_cm * 10 Dim cY_mm As Double = cY_cm * 10 ' Tính diện tích Dim dArea_mm2 As Double = dArea_cm2 * 100 ' cm² → mm² ' Tính khoảng cách từ trọng tâm đến điểm xa nhất theo trục X và Y Dim maxDistX As Double = Math.Max(Math.Abs(maxX - cX_cm), Math.Abs(minX - cX_cm)) * 10 ' Đoạn đường xa nhất theo trục X (mm) Dim maxDistY As Double = Math.Max(Math.Abs(maxY - cY_cm), Math.Abs(minY - cY_cm)) * 10 ' Đoạn đường xa nhất theo trục Y (mm) ' Tính các momen quán tính theo mm² và mm⁴ Dim Ix_mm4 As Double = adPrincipalMoments(0) * 10000 ' cm⁴ → mm⁴ Dim Iy_mm4 As Double = adPrincipalMoments(1) * 10000 ' cm⁴ → mm⁴ ' Tính momen kháng uốn Wx và Wy Dim Wx_mm3 As Double = Ix_mm4 / maxDistY ' mm³ Dim Wy_mm3 As Double = Iy_mm4 / maxDistX ' mm³ ' Hiển thị kết quả trong hộp thoại MsgBox ("Diện tích: " & Round(dArea_mm2, 2) & " mm²" & vbCrLf & _ "Tọa độ trọng tâm: (" & Round(cX_mm, 2) & ", " & Round(cY_mm, 2) & ") mm" & vbCrLf & _ "Khoảng cách từ trục trung hòa:" & vbCrLf & _ "- Tới điểm xa nhất theo trục X: " & Round(maxDistX, 2) & " mm" & vbCrLf & _ "- Tới điểm xa nhất theo trục Y: " & Round(maxDistY, 2) & " mm" & vbCrLf & _ "Ix: " & Round(Ix_mm4, 2) & " mm⁴" & vbCrLf & _ "Iy: " & Round(Iy_mm4, 2) & " mm⁴" & vbCrLf & _ "Wx: " & Round(Wx_mm3, 2) & " mm³" & vbCrLf & _ "Wy: " & Round(Wy_mm3, 2) & " mm³", vbInformation, "iLogic Đặc trưng hình học:")
-
iLogic xuất tệp step hàng loạt Chạy ổn định trên Inventor 2022PHIÊN BẢN 1Dim rootFolder As String = ThisDoc.Path Dim stepFolder As String = rootFolder & "\_step" ' Tạo thư mục nếu chưa tồn tại If Not System.IO.Directory.Exists(stepFolder) Then System.IO.Directory.CreateDirectory(stepFolder) End If ' Lấy danh sách file .ipt và .iam Dim files = System.IO.Directory.GetFiles(rootFolder, "*.ipt") files = files.Concat(System.IO.Directory.GetFiles(rootFolder, "*.iam")).ToArray() ' Thiết lập tùy chọn STEP Dim ctx As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap() Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap() Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext() oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism Dim oSTEP As TranslatorAddIn Dim i As Integer For i = 1 To ThisApplication.ApplicationAddIns.Count If ThisApplication.ApplicationAddIns.Item(i).ClassIdString = "{90AF7F40-0C01-11D5-8E83-0010B541CD80}" Then oSTEP = ThisApplication.ApplicationAddIns.Item(i) Exit For End If Next If oSTEP Is Nothing Then MessageBox.Show("Không tìm thấy STEP Translator.", "Lỗi") Return End If If Not oSTEP.Activated Then oSTEP.Activate() ' Lặp qua từng file và xuất ra STEP For Each filePath In files Try Dim doc As Document = ThisApplication.Documents.Open(filePath, False) Dim docName As String = System.IO.Path.GetFileNameWithoutExtension(filePath) Dim outputFile As String = stepFolder & "\" & docName & ".stp" Dim oData As DataMedium = ThisApplication.TransientObjects.CreateDataMedium() oData.FileName = outputFile oSTEP.SaveCopyAs(doc, oContext, oOptions, oData) doc.Close(True) Catch ex As Exception MessageBox.Show("Lỗi với file: " & filePath & vbCrLf & ex.Message, "Lỗi") End Try Next MessageBox.Show("Xuất STEP hoàn tất!", "Thành công")PHIÊN BẢN 2AddReference "System.Windows.Forms" Imports System.Windows.Forms Imports System.IO ' Chỉ xử lý file .ipt và .iam trong thư mục gốc, không duyệt thư mục con ' Không đóng mô hình hiện tại sau khi xuất ' Tạo danh sách tùy chọn Dim options As New ArrayList options.Add("Xuất tất cả các mô hình trong Project đang mở") options.Add("Xuất tất cả các mô hình trong thư mục được chọn") ' Hiển thị hộp thoại chọn tùy chọn Dim selectedOption = InputListBox("Chọn tùy chọn xuất file", options, options(0), "Xuất mô hình sang định dạng STEP", "Danh sách") ' Nếu hủy thì thoát If selectedOption = "" Then Return ' Xác định thư mục gốc dựa trên tùy chọn Dim rootFolder As String If selectedOption = options(0) Then rootFolder = ThisApplication.FileLocations.Workspace Else Dim folderDialog As New FolderBrowserDialog() folderDialog.Description = "Chọn thư mục chứa các mô hình" folderDialog.ShowNewFolderButton = False If folderDialog.ShowDialog() = DialogResult.OK Then rootFolder = folderDialog.SelectedPath Else Return End If End If ' Chọn thư mục đích lưu trữ Dim stepFolder As String Dim destFolderDialog As New FolderBrowserDialog() destFolderDialog.Description = "Chọn thư mục đích lưu trữ file STEP" destFolderDialog.ShowNewFolderButton = True If destFolderDialog.ShowDialog() = DialogResult.OK Then stepFolder = destFolderDialog.SelectedPath Else Return End If ' Tạo thư mục đích nếu chưa tồn tại If Not Directory.Exists(stepFolder) Then Directory.CreateDirectory(stepFolder) End If ' Lấy danh sách file .ipt và .iam chỉ trong thư mục gốc (không duyệt thư mục con) Dim iptFiles = Directory.EnumerateFiles(rootFolder, "*.ipt", SearchOption.TopDirectoryOnly) Dim iamFiles = Directory.EnumerateFiles(rootFolder, "*.iam", SearchOption.TopDirectoryOnly) Dim files = iptFiles.Concat(iamFiles).ToArray() ' Thiết lập tùy chọn STEP Dim ctx As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap() Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap() Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext() oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism Dim oSTEP As TranslatorAddIn Dim i As Integer For i = 1 To ThisApplication.ApplicationAddIns.Count If ThisApplication.ApplicationAddIns.Item(i).ClassIdString = "{90AF7F40-0C01-11D5-8E83-0010B541CD80}" Then oSTEP = ThisApplication.ApplicationAddIns.Item(i) Exit For End If Next If oSTEP Is Nothing Then MessageBox.Show("Không tìm thấy STEP Translator.", "Lỗi") Return End If If Not oSTEP.Activated Then oSTEP.Activate() ' Lấy tài liệu hiện tại Dim activeDoc As Document = ThisDoc.Document ' Lặp qua từng file và xuất ra STEP For Each filePath In files Try Dim doc As Document = ThisApplication.Documents.Open(filePath, False) ' Lấy tên file không có phần mở rộng Dim docName As String = System.IO.Path.GetFileNameWithoutExtension(filePath) Dim outputFile As String = stepFolder & "\" & docName & ".stp" Dim oData As DataMedium = ThisApplication.TransientObjects.CreateDataMedium() oData.FileName = outputFile oSTEP.SaveCopyAs(doc, oContext, oOptions, oData) ' Chỉ đóng tài liệu nếu không phải là tài liệu hiện tại If Not doc Is activeDoc Then doc.Close(True) End If Catch ex As Exception MessageBox.Show("Lỗi với file: " & filePath & vbCrLf & ex.Message, "Lỗi") End Try Next MessageBox.Show("Xuất STEP hoàn tất!", "Thành công")
