APIに詳しい方、ご協力お願いします。
API素人です。
Web検索や会員の方のブログなど参考にAPI作成し完成まであと一歩のところで、
壁にぶつかり悩んでます。APIにお詳しい方のお力添え頂きたく。解答よろしくお願いします。
アクティブモデル（Partsファイル、Assemblyファイル）のファイル名を
プロパティユーザー定義情報の組合せにより自動生成し指定保存するマクロになります。
「Parts保存」、「AssemblyをPartsとして保存」、「Assemblyのみ保存」は、問題なく出来ますが、
「Assembly保存+参照Partsを保存」が外部参照がはずれる関係で求めていることが出来ません。
外部参照が外れる原因は、参照部品の名前をコードで操作変更したときに外れるようで、
リネームなども試しましたが、AssemblyのFutureManager上では、名前リネームされますが、
外部参照が外れる関係で部品を開くとリネーム前の名前で部品が開きます。（外部参照設定もコードで有効にしてますが駄目です）
当方が求めている内容としては、下記になります。
①「Assembly保存+参照Partsを保存」を選択
②参照Partsは、自動生成したフォルダにプレフィックス追加し保存
※数個ある部品が正常に保存される時と1個しか保存されない時がある（不安定）
③Assemblyファイルは選択したフォルダに保存（参照は外さない）
※まともに②部品が保存できても参照が外れAssembly選択フォルダに名前変更前の部品ファイルが保存される。
すでに数日悩んでますが、どうしたら正常実行可能か分かりません。。
どなたか解決頂けると非常に助かります。
悩んでいるコード抜粋します。
'Assemblyの構成部品を指定フォルダに保存
Dim swAssy As SldWorks.AssemblyDoc
Dim swConfig As SldWorks.Configuration
Dim swRootComp As SldWorks.Component
Dim Children As Variant
Dim swChild As SldWorks.Component
Dim ChildCount As Integer
Dim OldName As String
Dim NewName As String
Dim bOldSetting As Boolean
Dim bRet As Boolean
Dim i As Long
Dim i1 As Long
Set swApp = CreateObject("SldWorks.Application")
Set swAssy = swApp.ActiveDoc
Set swConfig = swAssy.GetActiveConfiguration
Set swRootComp = swConfig.GetRootComponent
bOldSetting = swApp.GetUserPreferenceToggle(swExtRefUpdateCompNames)
swApp.SetUserPreferenceToggle swExtRefUpdateCompNames, False
Children = swRootComp.GetChildren
ChildCount = UBound(Children)
i = 0
i1 = 1
For i = 0 To ChildCount
Set swChild = Children(i)
bRet = swChild.Select(False)
'現在の構成部品名を読み込み
OldName = swChild.Name2
'外部参照有効化
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swExtRefUpdateCompNames, True
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swReferenceOnlyEnvelopeComponentType, False
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swReferenceInContextOfTopLevelAssembly, False
'現在の構成部品名に設備NOを追加
NewName = rValOut1 & "_" & OldName
'構成部品名書込
swChild.Name2 = NewName
'Set Part = swApp.ActiveDoc
'boolstatus = Part.Extension.SelectByID2(rValOut, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
'Rename
'longstatus = Part.Extension.RenameDocument(NewName)
'boolstatus = Part.ForceRebuild3(True)
'構成部品保存
NewName = fPath1 & "\" & NewName & ".SLDPRT"
fPath1 = NewName
boolstatus = swExt.SaveAs(fPath1, 0, Options, Nothing, errors, warnings)
i1 = i1 + 1
Next i
boolstatus = swAssy.ForceRebuild3(False)
'Assemblyを保存
fPath = BrowseFolder & "\" & rValOut & ".SLDASM"
boolstatus = swExt.SaveAs(fPath, 0, Options, Nothing, errors, warnings)
よろしくお願いします。
コメント
> 解決しました。
勉強になりました。情報提供ありがとうございます！
解決しました。
アセンブリパーツをパーツとして保存する場合は、部品種類ごとに作成してあるテンプレートを選択できるように
SW標準のテンプレート選択ウィンドウ表示し選択適用できるようにしました。
参考コード抜粋：
Dim Ptemp As String
'SW標準のテンプレート選択ウィンドウ表示
Ptemp = swApp.GetDocumentTemplate(swDocPART, "", 0, 0#, 0#)
'部品デフォルトテンプレートを選択テンプレートに設定
boolstatus = swApp.SetUserPreferenceStringValue(swUserPreferenceStringValue_e.swDefaultTemplatePart, Ptemp)
【システムオプション】→【デフォルトテンプレート】の設定は、
「ドキュメントのテンプレートを選択するようプロンプト表示」を選択にして下さい。
先日の投稿ですが、困っている内容が少し違ったので、再度投稿します。
AssemblyファイルをPartsとして保存するときに「オプション」設定のデフォルトテンプレート（部品）が
適用されますが、これを指定して適用したい方法が不明です。
SW標準保存であれば、テンプレート選択ウィンドウが表示され選択可能なので、マクロ記録し試しましたが、
NewDocumentで指定した部品ファイルは開くが、モデルが保存されないです。
【SW標準保存記録コードAssemblyファイルをPartsとして保存】
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swSaveAssemblyAsPartOptions, swSaveAsmAsPartOptions_e.swSaveAsmAsPart_AllComponents)
' New Document
Dim swSheetWidth As Double
swSheetWidth = 0
Dim swSheetHeight As Double
swSheetHeight = 0
Set Part = swApp.NewDocument("指定テンプレート.prtdot", 0, swSheetWidth, swSheetHeight)
Dim swPart As PartDoc
Set swPart = Part
swApp.ActivateDoc2 "Part1", False, longstatus
"Part1"は、NewDocument実行した時点で、自動で割付され部品用指定テンプレートが開くが、
SW終了するまで、NewDocument実行するたび番号積算されるので、何番になるか毎回番号が
変わるので、実際は指定ができない。次番号が何番になるか確認し数字入れてはみましたが、
NewDocumentで開いた部品ファイルに保存されません。
Set Part = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "テスト用Assemblyモデル.SLDASM", False, longstatus
Set Part = swApp.ActiveDoc
' Save As
longstatus = Part.SaveAs3("ファイルパス.SLDPRT", 0, 2)
End Sub
何か方法あれば、教えて下さい。
よろしくお願いします。
また困りました。
AssemblyファイルをPartsとして保存するときに作成済みの部品用プロパティテンプレートを
適用したいのですが、方法がわかりません。今は勝手に違う部品用テンプレートが適用されてしまいます。
保存時に指定プロパティテンプレートを適用する方法を教えて下さい。
よろしくお願いします。
追記します。
swComp.Name2で取得した構成部品名には、必ず末尾に子NO,がついてしまいますが、
不要につきInStrRevで末尾から”ー”位置取得しMidにて取得した文字位置から文字列取得、
Replaceで末尾”ー”以降を置換え（削除）するようにしました。
'現在の構成部品名を読み込み
Dim OldName As String
OldName = swComp.Name2
'ファイル名の子NO確認
Dim j As Long
j = InStrRev(OldName, "-")
Dim txt As String
txt = Mid(OldName, j)
'子番号置換（削除）
OldName = Replace(OldName, txt, "")
連休前に追加しておいた「一度保存したデータを違う設備で使い回す」は、多々あるので残しました。
'取得した構成部品名の左(先頭)から4文字取得
Dim ChangeName As String
ChangeName = OldName
ChangeName = Left(ChangeName, 4)
'取得した構成部品の左4文字が数字だった場合実行
If IsNumeric(ChangeName) = True Then
OldName = Replace(OldName, ChangeName & "_", "")
End If
あとは、サブアセンブリがあった場合の処理を頑張ります！
重箱の隅つつかれるとダダ漏れしますよ（笑）連休明けフル回転で煙もでてますが。。
Instrやっと理解できました。今回のように詳しく教えて頂かないと、
すぐパンクするので手取り足取りで説明お願いします（笑）
たしかにこの方法であれば、Nextで回してるので、つけたいプレフィックス名で判断がつくことになります。
If InStr(取得名, プレフィックス名) = 0 Then
SaveAs実行
実行結果はすばらしい完璧です！これなら子番号に左右されず判定できますね。
AAAA<1>
AAAA<2>
※取得順は選べない
↓
OldName：AAAA-1 or AAAA-2
Prefix：0000_
InStr (OldName, Prefix) = 0なので、SaveAs実行
↓
0000_AAAA-1<1>
0000_AAAA-1<2>
※SaveAsで同名部品書換られる
※取得順は選べない
↓
OldName：0000_AAAA-1-1 or 0000_AAAA-1-2
Prefix：0000_
InStr (OldName, Prefix) = 1なので、SaveAs未実行
すごくスッキリしました！
あとは、アセンブリにサブアセンブリがあった場合どうするか・・・う～ん。。。Zzzzzz
InStrでの判定、これもうまく伝わっていないようですね。というかマクロを実行したときの挙動を把握出来ていないのかも知れません。（.AddPrefix専用コード？＜－その話ではないです、これは私も初耳（目？））
STEP BY STEPで１行ずつ見ていくと解りますが、SaveAsの行を実行すると、保存と同時に複数ある同じ構成部品の名前は一斉に変更されます。
なので”For Next”なり”Do While”なりの内側で次の名前を取得すると、同じ部品なら既に追加したい文字が付いていることになります。（だからここで再度同じ処理をすると文字の追加を繰り返してしまうのですね。）
ここで、InStr(取得した名前，追加したい文字）で判定すると戻り値は、既に追加したい文字が含まれていれば何番目かの数字になるので１以上、含まれていなければ０となって区別できることになります。（０の時だけ保存処理を実行）
保存の繰り返し処理の前に、現状の名前を取得して配列に入れておき、それに対して文字追加するという方法も可能ですが、この場合インスタンス数回、同名で上書き保存することなってわずらわしいですよね。
ぼくも重箱の隅を・・
> PathName = Right(PathName, 1)
11個以上同じファイルがあるとだぶりそうです。
ちなみにぼくはファイル名を配列に入れて逐一チェックしようかとイメージしてたので
それよりはマシですね（笑）
> 【設備ハンディボックス用カールコード】設計に必要アルかナシかで言えば、ナシ
見てわかりやすいのはいろいろ気づくきっかけになるので大事だと思いますよ！
色もつけましょう！笑
理解しましたよ。
<>番号1のインスタンスを削除・・確かにレアケースではありますが、無くはないですね。
さて、どうしましょう？少し考えます。明日からの3連休で記憶から消す可能性もありますが・・（笑）
アップサンプル画像の【元データ構成】から、同名参照部品が何個あるか見分ける
何かいい方法あれば、教えて頂けると助かります。
プレフィックスに関しては、表現が悪かったですね。.AddPrefix専用コード？で接頭につけていないです。
単純に取得した名前の先頭に4桁の設備NO,＆"_"をつけただけで、同じ部品であっても
設備ごとに名前を変えて保存してます。
理由としては、社内で部品ファイル共有できてなく基本個人プレーで、ファイルは設備ごとのフォルダ作り
共有ネットワークに保存してます。仮にAさんとBさんで同じアセンブリを使用しAさんが参照部品を変更した場合、
Bさんの部品も変更されてしまうので、設備ごとに違う設備番号をファイル名や参照部品名の先頭につけることで、
同じ部品であってもリンクしないようにしてます。なので、InStrでの判定はできないかと。。
ただ、一度保存したデータを違う設備で使用する場合、既に先頭に違う設備NO,がついているので
違う名前にしたいときに追加で違う設備NO,をつけることになり、0000_1111_・・・マクロ使うたび増えるので、
取得部品名の左4文字取得し数字だった場合は、一度消して新たな設備NO,をつけるようにしておきました。
ChangeName = swComp.Name2
ChangeName = Left(ChangeName, 4)
If IsNumeric(ChangeName) = True Then
OldName = Replace(OldName, ChangeName & "_", "")
End If
今回作ったマクロは毎回このマクロで保存する訳ではなく、プロパティ組合せた決まった形式で
ファイル名を自動でつけたい場合に使用することを大前提としているので、マクロで保存した後の
変更や追加後の保存は基本的にSW標準の保存を使用します。じゃないと複雑になりすぎるので・・・
なので、万人向けではありません。
うまく伝えられなかったですかね。
一度構成部品を複数挿入・配置したけど、「やっぱりこれ要らんわ。」となって”－１”番目を削除していたら？という場合です。まあ、レアケースかもしれませんが無くはないということで。
InStrでの判定も、マクロ中のプレフィックス文字を付けるタイミングでの、「既に付いているか？」を見るので、その後の改定とはあまり関係ないかと思うのですが・・・。
また元々の名前に含まれている可能性についても、更に手間をかけると、プレフィックスなら文字の位置を特定することで識別は可能ですね。
＞業務の傍ら挑戦したところ業務以上にどっぷりハマってます。。。
わかります！私もうまくいかないと気になってしょうがないので、マクロは暇な時しか手を出さないようにしています。