Inventor iLogic|更换图纸格式

Option Explicit OnImports System' ============================================================'  更换图框'  手动运行：用 InputListBox 弹出列表，选择目标图纸格式' ============================================================Sub Main()    If Not TypeOf ThisDoc.Document Is DrawingDocument Then        MessageBox.Show("请在工程图文档中运行。", "提示")        Return    End If    Dim doc As DrawingDocument = ThisDoc.Document    ' ---- 收集所有图纸格式名称 ----    Dim formatNames As New List(Of String)    For Each fmt As SheetFormat In doc.SheetFormats        formatNames.Add(fmt.Name)    Next    If formatNames.Count = 0 Then        MessageBox.Show("当前工程图中没有任何图纸格式。", "提示")        Return    End If    formatNames.Sort()    ' ---- 弹出内置列表让用户选择 ----    Dim selectedName As String = ""    Try        selectedName = CStr(InputListBox("请选择要切换的图纸格式：", _                                         formatNames, _                                         formatNames(0), _                                         "更换图框", _                                         "确定"))    Catch    End Try    If String.IsNullOrEmpty(selectedName) Then Return    ' ---- 定位 SheetFormat ----    Dim selectedFormat As SheetFormat = Nothing    For Each fmt As SheetFormat In doc.SheetFormats        If fmt.Name = selectedName Then            selectedFormat = fmt            Exit For        End If    Next    If selectedFormat Is Nothing Then Return    ' ---- 事务中执行，Ctrl+Z 可一键撤销 ----    Dim errs As New System.Text.StringBuilder()    Dim tm As TransactionManager = ThisApplication.TransactionManager    Dim mainTrans As Transaction = tm.StartTransaction(doc, "更换图框")    Try        ExecuteChangeCore(doc, selectedFormat, errs)        doc.Update()        mainTrans.End()        If errs.Length > 0 Then            MessageBox.Show("操作完成，但有以下步骤失败：" & vbCrLf & vbCrLf & errs.ToString() & vbCrLf & vbCrLf & _                            "按 Ctrl+Z 可一键撤销。", "部分失败", MessageBoxButtons.OK, MessageBoxIcon.Warning)        Else            MessageBox.Show("操作完成！" & vbCrLf & vbCrLf & "按 Ctrl+Z 可一键撤销。", _                            "完成", MessageBoxButtons.OK, MessageBoxIcon.Information)        End If    Catch ex As Exception        Try            mainTrans.Abort()        Catch        End Try        MessageBox.Show("操作失败，已自动回滚：" & vbCrLf & ex.GetType().Name & vbCrLf & ex.Message, _                        "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)    End TryEnd Sub' ============================================================'  核心执行：删旧 → 切方向 → 改尺寸 → 加图框 → 加标题栏' ============================================================Sub ExecuteChangeCore(doc As DrawingDocument, selectedFormat As SheetFormat, _                      ByRef errs As System.Text.StringBuilder)    ' ---- 从目标格式中提取各项参数 ----    Dim targetSize As String = selectedFormat.Size.ToString().Replace("k", "").Replace("DrawingSheetSize", "")    Dim targetBorder As String = ""    If selectedFormat.ReferencedBorderDefinition IsNot Nothing Then        targetBorder = selectedFormat.ReferencedBorderDefinition.Name    End If    Dim targetTb As String = ""    If selectedFormat.ReferencedTitleBlockDefinition IsNot Nothing Then        targetTb = selectedFormat.ReferencedTitleBlockDefinition.Name    End If    Dim targetOrient As Integer = CInt(selectedFormat.Orientation)    ' ---- 1. 删图框 ----    Dim curBorder As String = ""    If doc.ActiveSheet.Border IsNot Nothing Then        curBorder = doc.ActiveSheet.Border.Definition.Name    End If    If Not String.Equals(curBorder, targetBorder, StringComparison.OrdinalIgnoreCase) Then        If doc.ActiveSheet.Border IsNot Nothing Then            Try                doc.ActiveSheet.Border.Delete()            Catch ex As Exception                errs.AppendLine("【删图框】" & ex.GetType().Name & ": " & ex.Message)            End Try        End If    End If    ' ---- 2. 删标题栏 ----    Dim curTb As String = ""    If doc.ActiveSheet.TitleBlock IsNot Nothing Then        curTb = doc.ActiveSheet.TitleBlock.Definition.Name    End If    If Not String.Equals(curTb, targetTb, StringComparison.OrdinalIgnoreCase) Then        If doc.ActiveSheet.TitleBlock IsNot Nothing Then            Try                doc.ActiveSheet.TitleBlock.Delete()            Catch ex As Exception                errs.AppendLine("【删标题栏】" & ex.GetType().Name & ": " & ex.Message)            End Try        End If    End If    ' ---- 3. 切方向 ----    Try        Dim targetOrientEnum As PageOrientationTypeEnum = CType(targetOrient, PageOrientationTypeEnum)        If doc.ActiveSheet.Orientation <> targetOrientEnum Then            doc.ActiveSheet.Orientation = targetOrientEnum        End If    Catch ex As Exception        errs.AppendLine("【方向】" & ex.GetType().Name & ": " & ex.Message)    End Try    ' ---- 4. 改尺寸 ----    Dim curSize As String = doc.ActiveSheet.Size.ToString().Replace("k", "").Replace("DrawingSheetSize", "")    If Not String.Equals(curSize, targetSize, StringComparison.OrdinalIgnoreCase) Then        Try            doc.ActiveSheet.Size = selectedFormat.Size        Catch ex As Exception            errs.AppendLine("【尺寸】" & ex.GetType().Name & ": " & ex.Message)        End Try    End If    ' ---- 5. 加图框 ----    Dim curBorder2 As String = ""    If doc.ActiveSheet.Border IsNot Nothing Then        curBorder2 = doc.ActiveSheet.Border.Definition.Name    End If    If Not String.Equals(curBorder2, targetBorder, StringComparison.OrdinalIgnoreCase) Then        Try            Dim bd As BorderDefinition = selectedFormat.ReferencedBorderDefinition            If bd IsNot Nothing Then doc.ActiveSheet.AddBorder(bd)        Catch ex As Exception            errs.AppendLine("【图框】目标=""" & targetBorder & """ " & ex.GetType().Name & ": " & ex.Message)        End Try    End If    ' ---- 6. 加标题栏 ----    Dim curTb2 As String = ""    If doc.ActiveSheet.TitleBlock IsNot Nothing Then        curTb2 = doc.ActiveSheet.TitleBlock.Definition.Name    End If    If Not String.Equals(curTb2, targetTb, StringComparison.OrdinalIgnoreCase) Then        Try            Dim td As TitleBlockDefinition = selectedFormat.ReferencedTitleBlockDefinition            If td IsNot Nothing Then doc.ActiveSheet.AddTitleBlock(td)        Catch ex As Exception            errs.AppendLine("【标题栏】目标=""" & targetTb & """ " & ex.GetType().Name & ": " & ex.Message)        End Try    End IfEnd Sub