異なるUUIDのDraw参照元ファイルを差し替える3

こちらの続きです。
異なるUUIDのDraw参照元ファイルを差し替える2 - C#ATIA

あちらのマクロを実際に業務で使用していると、リンクを持たないビューまで
リンク付きのビューにしてしまう為、使い勝手が非常に悪かったです。

その為、リンク元を差し替えるビューをユーザーが選択できるように
変更しました。

'vba ChangeDrawLink ver0.0.2  using-'KCL0.0.12'  by Kantoku
'Drawのﾋﾞｭｰのﾘﾝｸの参照元を差し替える
'Partのみ?で　UUID違いOK

'ver0.0.1:完成
'ver0.0.2:ﾋﾞｭｰを指定するように変更

Option Explicit

Private Const SelectionType = "*.CATPart"

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    'view選択
    Dim Msg As String
    Msg = "置き換えるﾋﾞｭｰを選択してください"
    
    Dim views As Collection
    Set views = SelectViews(Msg)
    If views Is Nothing Then Exit Sub
    If views.Count < 1 Then Exit Sub
    
    'ﾌｧｲﾙ選択
    Msg = "Drawで参照するﾌｧｲﾙを選択してください"
    
    Dim path As String
    path = CATIA.FileSelectionBox( _
        Msg, _
        SelectionType, _
        CatFileSelectionModeOpen)
    If path = vbNullString Then Exit Sub
    
    'Draw
    Dim drawDoc As DrawingDocument
    Set drawDoc = CATIA.ActiveDocument
    
    '確認
    Msg = "以下のビュー" & vbCrLf & _
        GetViewsName(views) & _
        "を、リンクの参照元" & vbCrLf & _
        path & vbCrLf & _
        "に置き換えます。宜しいですか?"
        
    If MsgBox(Msg, vbYesNo + vbQuestion) = vbNo Then Exit Sub
    
    Dim viws As DrawingViews
    Set viws = drawDoc.Sheets.ActiveSheet.views
    
    '参照ｵｰﾌﾟﾝ
    Dim refDoc As Document
    Set refDoc = CATIA.Documents.Open(path)
    
    'すり替え
    Dim vi As DrawingView
    
    For Each vi In views
        Call ChangeLink(vi, refDoc)
    Next
    
    '参照ｸﾛｰｽﾞ
    Call refDoc.Close
    
    MsgBox "Done"
End Sub

'ﾋﾞｭｰの選択
Private Function SelectViews( _
    ByVal Msg As String) As Collection

    Dim sel As Variant
    Set sel = CATIA.ActiveDocument.selection

    Dim filter As Variant
    filter = Array("DrawingView")

    sel.Clear
    Select Case sel.SelectElement3(filter, Msg, True, _
        CATMultiSelTriggWhenUserValidatesSelection, False)
        Case "Cancel", "Undo", "Redo"
            Exit Function
    End Select

    Dim lst As Collection
    Set lst = New Collection

    Dim i As Long
    For i = 1 To sel.Count2
        lst.Add sel.Item(i).Value
    Next
    sel.Clear

    Set SelectViews = lst
End Function

'ｺﾚｸｼｮﾝ内のﾋﾞｭｰ名をﾃｷｽﾄ化
Private Function GetViewsName( _
    ByVal lst As Collection) As String

    Dim ary() As String
    ReDim ary(lst.Count)
    
    Dim i As Long
    For i = 1 To lst.Count
        ary(i - 1) = lst.Item(i).Name
    Next
    
    GetViewsName = Join(ary, vbCrLf)
End Function

'すり替え&Update
Private Sub ChangeLink( _
    ByVal viw As DrawingView, _
    ByVal doc As Document)

    Dim links As DrawingViewGenerativeLinks
    Set links = viw.GenerativeLinks
    links.RemoveAllLinks

    Dim behv As DrawingViewGenerativeBehavior
    Set behv = viw.GenerativeBehavior

    behv.Document = doc
    behv.Update
End Sub

マクロ実行後、ビューを選択（複数選択可能です）し、続いて
リンク元となるPartファイルを指定すればOKです。
指定するPartファイルはUUIDの一致不一致を問いません。

唯一の欠点は、更新後本来寸法解析した際赤くなるべき寸法が
何食わぬ顔して（黒のまま）終了してしまう事です。
これは更新しても直りません。

対策としては、再度手動でリンク元を同じファイルで置換し更新すれば
OKなのですが手間と言えばかなり手間です。

但し、UUID違いは手動ではリンク元を置換できない為、個人的には
かなり重宝します。

そして、リンクを分断したビューでもリンクを復活させる事も可能です！
（もちろん寸法はﾁﾏﾁﾏ直す必要は有ります）

リンク切れと意図的にリンクを切ったビューの判断

Drawのビューで、赤印のリンク切れと青印の意図的にリンクを切ったビューを
マクロで判断することは可能なのかな？

こちらのマクロで処理すると意図的にリンクを切ったビューにも
新たにリンクが発生して、毎回消すのがメンドクサイ！
異なるUUIDのDraw参照元ファイルを差し替える2 - C#ATIA

形状ｾｯﾄ要素の対称化ﾏｸﾛ2

こちらの続きです。
形状ｾｯﾄ要素の対称化ﾏｸﾛ - C#ATIA

元の対称化するマクロですが、色の反映を追加しました。

'vba 指定した形状ｾｯﾄを対称化しｺﾋﾟﾍﾟ2
Option Explicit

Dim PartDoc As PartDocument
Dim Part As Part
Dim sel 'As Selection
Dim HSFact As HybridShapeFactory
Dim BasePlane As Reference
Dim DeleteItems As New Collection

Sub CATMain()
    '初期設定
    Set PartDoc = CATIA.ActiveDocument
    Set Part = PartDoc.Part
    Set sel = PartDoc.selection
    
    '元の形状ｾｯﾄ選択
    Dim BaseHBody As HybridBody
    Set BaseHBody = SelectHybridBody
    
    '対象平面選択
    Set BasePlane = SelectPlanarFace
    
    '形状ｾｯﾄｺﾋﾟﾍﾟ
    Dim MirrerHBody As HybridBody
    Set MirrerHBody = CopyPasteHybridBody(BaseHBody)
    MirrerHBody.Name = BaseHBody.Name + "_Symmetry"
    
    '対称化
    Set HSFact = Part.HybridShapeFactory
    Call HBodyLoop(MirrerHBody)
    
    '終了
    Call DeleteItem
    Part.Update
    MsgBox ("終了")
End Sub

'ｺﾋﾟﾍﾟした要素を削除
Private Sub DeleteItem()
    Dim Ref As Reference
    For Each Ref In DeleteItems
        Call HSFact.DeleteObjectForDatum(Ref)
    Next
End Sub

'形状ｾｯﾄﾙｰﾌﾟ-再帰
Private Sub HBodyLoop(HBody As HybridBody)
    Call SymmetryItem(HBody.HybridShapes)
    If HBody.HybridBodies.Count = 0 Then Exit Sub '下階層無し
    
    Dim HB As HybridBody
    For Each HB In HBody.HybridBodies
        Call HBodyLoop(HB)
    Next
End Sub

'対称
Private Sub SymmetryItem(HShapes As HybridShapes)
    Dim HShape As HybridShape
    Dim Ref As Reference
    Dim rgb As Variant
    Dim sym As HybridShape
    
    For Each HShape In HShapes
        Set Ref = Part.CreateReferenceFromObject(HShape)
        rgb = GetColor(HShape)
        If HSFact.GetGeometricalFeatureType(Ref) <> 0 Then
            Call DeleteItems.Add(Ref) '削除登録
            Set sym = CreateDatum(CreateSymmetry(Ref, BasePlane))
            Call setColor(sym, rgb)
            Call HShapes.Parent.AppendHybridShape(sym)
        End If
    Next
End Sub

'色取得
Private Function GetColor( _
    ByVal shape As HybridShape) As Variant
    
    sel.Clear
    sel.Add shape
    
    Dim vis As VisPropertySet
    Set vis = sel.VisProperties
    
    Dim rgb(2) As Long
    vis.GetRealColor rgb(0), rgb(1), rgb(2)
    
    sel.Clear
    GetColor = rgb
End Function

'色設定
Private Sub setColor( _
    ByVal shape As HybridShape, _
    ByVal rgb As Variant)
        
    sel.Clear
    sel.Add shape
    
    Dim vis As VisPropertySet
    Set vis = sel.VisProperties
    
    Call vis.SetRealColor(rgb(0), rgb(1), rgb(2), 1)
    sel.Clear
End Sub

'Symmetry
Private Function CreateSymmetry(ItemRef As Reference, PlaneRef As Reference) As Reference
    Dim Symmetry As HybridShapeSymmetry
    Set Symmetry = HSFact.AddNewSymmetry(ItemRef, PlaneRef)
    Symmetry.VolumeResult = False
    Call Part.UpdateObject(Symmetry)
    Set CreateSymmetry = Part.CreateReferenceFromObject(Symmetry)
    Call DeleteItems.Add(CreateSymmetry) '削除登録
End Function

'Datum
Private Function CreateDatum(Ref As Reference) As AnyObject
    Dim Datum As AnyObject
    Select Case HSFact.GetGeometricalFeatureType(Ref)
        Case 1 'Point
            Set Datum = HSFact.AddNewPointDatum(Ref)
        Case 2 'Curve
            Set Datum = HSFact.AddNewCurveDatum(Ref)
        Case 3 'Line
            Set Datum = HSFact.AddNewLineDatum(Ref)
        Case 4 'Circle
            Set Datum = HSFact.AddNewCircleDatum(Ref)
        Case 5 'Surface
            Set Datum = HSFact.AddNewSurfaceDatum(Ref)
        Case 6 'Plane
            Set Datum = HSFact.AddNewPlaneDatum(Ref)
        Case 7 'Volume
            Set Datum = HSFact.AddNewVolumeDatum(Ref)
    End Select
    Call Part.UpdateObject(Datum)
    Set CreateDatum = Datum
End Function

'形状ｾｯﾄのｺﾋﾟﾍﾟ
Private Function CopyPasteHybridBody(HBody As HybridBody) As HybridBody
    With sel
        .Clear
        .Add HBody
        .Copy
        .Clear
        .Add Part
        .Paste
    End With
    With Part.HybridBodies
        Set CopyPasteHybridBody = .Item(.Count)
    End With
End Function

'平面の選択
Private Function SelectPlanarFace() As Reference
    Dim FilterType(0)  As Variant
    FilterType(0) = "PlanarFace"
    Call SelectItem(FilterType, "対称基準となる平面を選択して下さい / ESCｷｰ ｷｬﾝｾﾙ")
    Set SelectPlanarFace = Part.CreateReferenceFromBRepName( _
                    GetBrepName(sel.Item(1).Value.Name), sel.Item(1).Value.Parent)
End Function

'SelectElement用BrapName取得
Private Function GetBrepName(MyBRepName As String) As String
    MyBRepName = Replace(MyBRepName, "Selection_", "")
    MyBRepName = Left(MyBRepName, InStrRev(MyBRepName, "));"))
    MyBRepName = MyBRepName + ");WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)"
    GetBrepName = MyBRepName
End Function

'形状ｾｯﾄ選択
Private Function SelectHybridBody() As HybridBody
    Dim FilterType(0)  As Variant
    FilterType(0) = "HybridBody"
    Call SelectItem(FilterType, "元となる形状ｾｯﾄを選択して下さい / ESCｷｰ ｷｬﾝｾﾙ")
    Set SelectHybridBody = sel.Item(1).Value
End Function

'選択
Private Sub SelectItem(FilterType As Variant, Msg As String)
    sel.Clear
    If sel.SelectElement2(FilterType, Msg, False) = "Cancel" Then End
End Sub

SymmetryItem関数を修正し、GetColor関数、SetColor関数の2個を追加
しました。

第三回仮予選！モデリングバトル予選大会

こちらの続きです。
第二回仮予選！モデリングバトル予選大会 - C#ATIA

fusion360.3dworks.co.jp

今週は忘れなかった。

ｵﾌｾｯﾄ平面をﾘﾈｰﾑ3

こちらの続きです。
ｵﾌｾｯﾄ平面をﾘﾈｰﾑ2 - C#ATIA

また、面倒くさい虫が現れました。
大量のPartファイルが有り、一枚一枚平面名を修正するのが面倒です。

以前は、ｵﾌｾｯﾄ平面の親子関係を取得できないので断念していたのですが、
平面名が変更されなくなるまで強制的にループさせてしまおう　と思い付き
Partファイル内のｵﾌｾｯﾄ平面をまとめて処理させるようにしました。

'vba Part_OffsetPleneRename_ver0.0.3  using-'KCL0.0.12'  by Kantoku

'ver0.0.1:完成
'ver0.0.2:座標系平面対応
'ver0.0.3:全体を自動化

Option Explicit

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("PartDocument") Then Exit Sub
    
    'ｵﾌｾｯﾄ平面
    Dim offs As Object
    Set offs = GetPlaneOffset()
    If offs Is Nothing Then
        MsgBox "修正すべきｵﾌｾｯﾄ平面が有りませんでした", vbInformation
        Exit Sub
    End If
    
    '確認
    Dim msg As String
    msg = offs.count & "個のｵﾌｾｯﾄ平面があります。" & vbCrLf & _
        "ﾘﾈｰﾑを試みますか?"
    If MsgBox(msg, vbYesNo + vbQuestion) = vbNo Then Exit Sub
    
    '実行前ﾈｰﾑﾘｽﾄ
    Dim before As Object
    Set before = GetPlaneNameLst(offs)
    
    'ﾘﾈｰﾑ
    Call ExecRename(offs)
    
    '変更ﾘｽﾄ
    Dim changes As Object
    Set changes = GetChangeLst(offs, before)
    
    '結果
    If changes Is Nothing Then
        msg = "変更有りませんでした"
    Else
        msg = "以下を変更しました" & vbCrLf & _
            String(20, "-") & vbCrLf & _
            Join(changes.ToArray(), vbCrLf)
    End If
    
    CATIA.RefreshDisplay = True
    MsgBox msg, vbInformation

End Sub

'参照元座標系時の新たな平面名取得
Private Function GetAxisPlaneName(ByVal pln As Plane) As String
    GetAxisPlaneName = vbNullString
    
    Dim info As Variant
    info = GetBrepInfo(pln.Plane.DisplayName)
    
    Dim pt As part
    Set pt = KCL.GetParent_Of_T(pln, "Part")
    
    Dim inter As String
    Dim ax As AxisSystem
    Dim hit As AxisSystem: Set hit = Nothing
    
    For Each ax In pt.AxisSystems
        inter = KCL.GetInternalName(ax)
        If inter = info(0) Then
            Set hit = ax
            Exit For
        End If
    Next
    If hit Is Nothing Then Exit Function
    
    Dim direction As String
    Select Case info(1)
        Case 1 'XY平面
            direction = "Z"
        Case 2 'YZ平面
            direction = "X"
        Case 3 'ZX平面
            direction = "Y"
        Case Else
            '多分無いはず。止まったら連絡下さい
            Stop
    End Select
    GetAxisPlaneName = hit.name & "_" & direction & "="
End Function

'BrapNameから参照情報取得
Private Function GetBrepInfo(ByVal BrepName As String) As Variant
    Dim tmp As Variant
    tmp = Split(BrepName, "RSur:(Face:(Brp:(")
    tmp = Split(tmp(1), ")")
    GetBrepInfo = Split(tmp(0), ";")
End Function

'数値を+-付きの文字にする
Private Function Num2Str(ByVal Num As Double) As String
    Num2Str = IIf(Num > 0, "+", "") & CStr(Num)
End Function
 
'新たな平面名取得
Private Function GetPlaneName(ByVal RefPlnName As Reference) As String
    Select Case RefPlnName.DisplayName
        Case "xy plane", "XY平面"
            GetPlaneName = "Z"
        Case "yz plane", "YZ平面"
            GetPlaneName = "X"
        Case "zx plane", "ZX平面"
            GetPlaneName = "Y"
        Case Else
            GetPlaneName = RefPlnName.DisplayName
    End Select
End Function

'ﾘﾈｰﾑする可能性のある平面ﾘｽﾄ取得
Private Function GetPlaneOffset() As Object

    Set GetPlaneOffset = Nothing
    
    Dim sel As Selection
    Set sel = CATIA.ActiveDocument.Selection
    
    CATIA.HSOSynchronized = False
    
    sel.Clear
    sel.Search "CATPrtSearch.GSMPlaneOffset,all"
    If sel.Count2 < 1 Then Exit Function
    
    Dim lst As Object
    Set lst = KCL.InitLst()
    
    Dim i As Long
    Dim pln As Plane
    For i = 1 To sel.Count2
        Set pln = sel.Item(i).Value
        If IsReferencePlane(pln) Then
            lst.Add pln
        End If
    Next
    sel.Clear
    CATIA.HSOSynchronized = True
    
    If lst.count < 1 Then Exit Function
    
    Set GetPlaneOffset = lst
End Function

'参照元は平面か？
Private Function IsReferencePlane( _
    ByVal pln As Plane) As Boolean
    
    IsReferencePlane = True
    
    If InStr(pln.Plane.DisplayName, "RSur:") > 0 Then
        '座標系の可能性
        Dim newName As String
        newName = GetAxisPlaneName(pln)
        If Len(newName) < 1 Then
            IsReferencePlane = False
        End If
    End If
End Function

'平面名ﾘｽﾄ
Private Function GetPlaneNameLst( _
    plns As Object) As Object
    
    Dim lst As Object
    Set lst = KCL.InitLst()
    
    Dim p As Plane
    For Each p In plns
        lst.Add p.name
    Next
    
    Set GetPlaneNameLst = lst
End Function

'ﾘﾈｰﾑ実行
Private Sub ExecRename( _
    plns As Object)
    
    Dim pln As Plane
    Dim newName As String
    Dim changeFG As Boolean
    
    Do
        changeFG = False
        
        For Each pln In plns
            If InStr(pln.Plane.DisplayName, "RSur:") > 0 Then
                newName = GetAxisPlaneName(pln)
            Else
                newName = GetPlaneName(pln.Plane)
            End If
            
            newName = newName & _
                Num2Str(pln.Offset.Value * pln.Orientation) & "mm"
            
            If Not pln.name = newName Then
                'ﾘﾈｰﾑ
                pln.name = newName
                changeFG = True
            End If
        Next
        
        If Not changeFG Then Exit Do
    Loop
End Sub

'変更された平面名のみ取得
Private Function GetChangeLst( _
    plns As Object, _
    before As Object) As Object
    
    Set GetChangeLst = Nothing
    
    Dim lst As Object
    Set lst = KCL.InitLst()
    
    Dim i As Long
    For i = 0 To plns.count - 1
        If Not plns(i).name = before(i) Then
            lst.Add before(i) & " -> " & plns(i).name
        End If
    Next
    
    If lst.count < 1 Then Exit Function
    
    Set GetChangeLst = lst
End Function

平面1　->　平面2　->　平面3　->　平面1　->　・・・
の様に参照元が循環ループ状態になっているのはCATIA自身で
チェックしてくれているので、無限ループには陥らないはず。

DrawをPDFでｴｸｽﾎﾟｰﾄ (未解決)3

こちらの続きです。
DrawをPDFでｴｸｽﾎﾟｰﾄ (未解決)2 - C#ATIA

ほぼ使わないので存在すら忘れていましたが、こちらのバッチマネージャに
印刷バッチがある事に気が付きました。

起動しプリンタでCubePDFを指定すると出ます。

しかも良く見ると、CATScriptが作れるようです。
（後でわかりましたが、印刷バッチ時に毎回CATScriptを実行しているようです）

VBAｴﾃﾞｨﾀにコードを貼り付けます（一部型指定のエラーがあるのでコメント化）

'Language = "VBSCRIPT"
Dim logFile As TextStream

'------------------------------------------
'---- CATMain()
'------------------------------------------
Sub CATMain()
  CATIA.DisplayFileAlerts = False

  '------------------------------------------
  '-  open the log file : C:\Users\XXX\AppData\Local\Temp\PrintBatch.log
  '------------------------------------------
  Dim AppliFileSys 'As FileSystem
  Set AppliFileSys = CATIA.FileSystem
  Dim FileObj As File
  Set FileObj = AppliFileSys.CreateFile("C:\Users\XXX\AppData\Local\Temp\PrintBatch.log", True)
  Set logFile = FileObj.OpenAsTextStream("ForWriting")

  '------------------------------------------
  '-  open the document file : C:\temp\hoge.CATDrawing
  '------------------------------------------
  OpenDocument "C:\temp\hoge.CATDrawing"

  Dim sheet As AnyObject
  Set sheet = CATIA.ActiveDocument.Sheets.Item(1)
  sheet.Activate

  '------------------------------------------
  '-  printer -
  '------------------------------------------
  Dim thePrinter As Printer
  Set thePrinter = CATIA.Printers.Item(3) '←プリンタを指定
  CATIA.ActivePrinter = thePrinter

  '------------------------------------------
  '-  parameters -
  '------------------------------------------
  Dim PageSetUp 'As CATIADrawingPageSetup
  Set PageSetUp = sheet.PageSetUp
  PageSetUp.PaperWidth = 210
  PageSetUp.PaperHeight = 297
  PageSetUp.Orientation = 0
  PageSetUp.LeftMargin = 10
  PageSetUp.RightMargin = 10
  PageSetUp.TopMargin = 10
  PageSetUp.BottomMargin = 10
  PageSetUp.BottomMargin = 10
  PageSetUp.FitToSheetFormat = True
  PageSetUp.MaximumSize = False
  PageSetUp.Left = 0
  PageSetUp.Bottom = 0
  PageSetUp.Zoom = 1
  PageSetUp.Rotation = 0
  PageSetUp.Color = 0
  PageSetUp.Quality = 0
  PageSetUp.Dpi = 150
  PageSetUp.Banner = "xxxx"
  PageSetUp.BannerPosition = 0
  PageSetUp.TextBlanking = False
  PageSetUp.WhiteVectorsInBlack = True
  PageSetUp.LineWidthSpecification = 0
  PageSetUp.LineTypeSpecification = 0
  PageSetUp.LineCap = 0
  PageSetUp.TextScaling = True
  PageSetUp.LineTypeOverlappingCheck = False
  PageSetUp.Gamma = 1
  Dim Document 'As CATIADocument
  Set Document = CATIA.ActiveDocument
  Err.Clear
  On Error Resume Next
  sheet.PrintOut '←印刷
  If Err = 0 Then
    logFile.Write "  Printing done "
  Else
    logFile.Write "  Printing failed "
    Err.Clear
  End If

  Set thePrinter = Nothing
  Set sheet = Nothing

  '------------------------------------------
  '-  close the document file : C:\temp\hoge.CATDrawing
  '------------------------------------------
  CloseDocument

  '------------------------------------------
  '-  close the log file -
  '------------------------------------------
  Set FileObj = Nothing
  Set AppliFileSys = Nothing
  logFile.Write " End of printing   "
  logFile.Close

  MsgBox "End of printing"
End Sub

'-------------------------------------------------------
'---- OpenDocument(FileName)
'-------------------------------------------------------
Sub OpenDocument(FileName As String)
  Dim TheCATIADocument As Document
  On Error Resume Next
  Set TheCATIADocument = CATIA.Documents.Open(FileName)
  If Err = 0 Then
    logFile.Write FileName
    logFile.Write " Opened "
  Else
    logFile.Write FileName
    logFile.Write " Failed to open "
    Err.Clear
  End If
  CATIA.ActiveWindow.WindowState = 0
End Sub

'-------------------------------------------------------
'---- CloseDocument()
'-------------------------------------------------------
Sub CloseDocument()
  Dim ActiveDoc As Document
  Set ActiveDoc = CATIA.ActiveDocument
  On Error Resume Next
  ActiveDoc.Close
  If Err = 0 Then
    logFile.Write " Active document closed "
  Else
    logFile.Write " Failed to close active document "
    Err.Clear
  End If
End Sub

プリンタの指定のインデックス部分は、各々の環境で違うはずです。
印刷自体はDrawingSheetのPrintOutメソッドで行っているんですね。
気が付かなかったです。

で、実行すると・・・白紙なんです。
試しに通常のプリンタを指定して実行しても、プリンタが少しだけ
反応して結局出ないんです。何だか煮え切らないです。

バッチマネージャは何をやっているのだろうか?

DrawをPDFでｴｸｽﾎﾟｰﾄ (未解決)2

図面を修正した際チェックする為にプロットしているのですが、
社内環境が非常に悪く、A1以上はPDFにして印刷しています。
表題欄のゴタゴタやリンク元のPartファイルが適切か？等は、マクロで
チェックさせているのですが、寸法自体が正しいかどうかは
人力しか方法が無さそうなので。

PDFにする際、SaveAsでも出来るのですが都合が悪いんです。

左からCATIAの画面、CubePDF(フリー仮想プリンタ）、SaveAs
面倒な思いをして「背景をブランク」しているのに（これはマクロではﾑﾘです）
SaveAsでPDFにすると機能していないんです。

以前サポートさんに問い合わせた所、ありがたいことに開発にまで
確認して頂いた上での回答は、「仕様です」との事。

仕方が無いので今の所、CubePDFで行うしか無さそうなのですが
（検索するとHitすると思いますが、CubePDFは外部に何らかの情報を
　発信しているソフトです。。。そんな事言ってられない）
途中でダイアログが出るので、まとめてガサっとは処理できません。

SaveAsならマクロでガサっと出来るんですけどね。
但しこちらに記載した狙ったシートのみをPDF化するのは出来なさそうです。
DrawをPDFでｴｸｽﾎﾟｰﾄ (未解決) - C#ATIA
海外のサイトでは「いらないPDFはマクロで削除している」みたいな事は
記載されていました。　そもそもディテールシートは要らないと
思うんですけどね。

CubePDF以外でVBAから呼び出せる何か良いライブラリのようなもの
どなたか知りませんかね？