読者です 読者をやめる 読者になる 読者になる

C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA

3Dの文字モデリングマクロ3

こちらの続きです。
3Dの文字モデリングマクロ2 - C#ATIA
まだ完成していないのですが、この先修正しないだろうと思われる部分を
公開していきたいと思います。

基本的にこちらで公開されているマクロを改造したものです。
http://www.ema3.com/CATIA_V5_MACRO/V5_index.php?e3dText
その為、こちらのサイトにUpされている「E3DTEXT.CATPart」ファイルが必要に
なります。



ドキュメント関連を保持するText3DDocContainerクラスです。

'text3D VBA
'Text3DDocContainer
Option Explicit

Private mCanUseClass As Boolean
Private mDoc As PartDocument
Private mSel As Selection
Private mPart As Part
Private mHSFac As HybridShapeFactory
Private mParams As Parameters
Private mSPAWorkBench As SPAWorkbench
Private mWorkHybridBody As HybridBody
Private mTempHybridBody As HybridBody
Private mAxisSystems As AxisSystems
Private mShapeFactory As ShapeFactory

Private Sub Class_Initialize()
    mCanUseClass = True
End Sub

'各種の設定
Sub SetDocument(Doc As Document)
    If (Not TryPartDoc(Doc, mDoc)) Then
        mCanUseClass = False
        Exit Sub
    End If
    Set mSel = mDoc.Selection
    Set mPart = mDoc.Part
    Set mHSFac = Me.Part.HybridShapeFactory
    Set mParams = Me.Part.Parameters
    Set mSPAWorkBench = Me.Doc.GetWorkbench("SPAWorkbench")
    Set mAxisSystems = Part.AxisSystems
    Set mShapeFactory = Part.ShapeFactory
End Sub

Property Get CanUseClass() As Boolean
    CanUseClass = mCanUseClass
End Property

Property Get Doc() As PartDocument
    Set Doc = mDoc
End Property

Property Get Sel() As Selection
    Set Sel = mSel
End Property

Property Get Part() As Part
    Set Part = mPart
End Property

Property Get HSFac() As HybridShapeFactory
    Set HSFac = mHSFac
End Property

Property Get Params() As Parameters
    Set Params = mParams
End Property

Property Get SPAWorkbench() 'As SPAWorkbench
    Set SPAWorkbench = mSPAWorkBench
End Property

Property Get WorkHybridBody() As HybridBody
    Set WorkHybridBody = mWorkHybridBody
End Property

Property Let WorkHybridBody(HBody As HybridBody)
    Set mWorkHybridBody = HBody
End Property

Property Get TempHybridBody() As HybridBody
    Set TempHybridBody = mTempHybridBody
End Property

Property Let TempHybridBody(HBody As HybridBody)
    Set mTempHybridBody = HBody
End Property

Property Get AxisSystems() As AxisSystems
    Set AxisSystems = mAxisSystems
End Property

Property Get ShapeFactory() As ShapeFactory
    Set ShapeFactory = mShapeFactory
End Property

'HybridBody作成
Sub CreateWorkHybridBody(Optional Name As String = "")
    WorkHybridBody = CreateHybridBody(Name)
End Sub

Sub CreateTempHybridBody(Optional Name As String = "")
    TempHybridBody = CreateHybridBody(Name)
End Sub

Private Function CreateHybridBody(Optional Name As String = "")
    Dim HBody As HybridBody
    Set HBody = Me.Part.HybridBodies.Add
    If Not Name = "" Then
        HBody.Name = Name
    End If
    Set CreateHybridBody = HBody
End Function

'PartDocumentチェック
Private Function TryPartDoc(InDoc As Document, ExDoc As PartDocument) As Boolean
    On Error Resume Next
          Set ExDoc = InDoc
          TryPartDoc = IIf(Err.Number = 0, True, False)
    On Error GoTo 0
End Function

オリジナルのマクロを見ると、実際に3DTextを作成するPartファイルとフォントのサーフェスが入っている
Partファイル(E3DTEXT.CATPart)を使用する為、このText3DDocContainerクラスを用意しました。
VBAのクラスは引数付きのコンストラクタが無いようなので、代案としてSetDocumentメソッドで
ドキュメントを受け取り、各プロパティを設定するようにしました。