こちらの続きです。
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メソッドで
ドキュメントを受け取り、各プロパティを設定するようにしました。