'---Drain_Ultimapper--- '---Machinery Contents--- '---Create by Praying Spider--- '---Release 2007/10/30---- '---Optimization Fales---- Option Explicit Dim SelObjCol,SelObj,TgtObj,Sts_A,Sts_B,Sts_C,Sts_D,Sts_E,Sts_F,Sts_G,Sts_H,Sts_I,ChkPtyCol, _ ChkPty,CpyObjCol,WarObjCol,CpyObj,WarObj,TanOpCol,ChkTxpCol,CpyObjSetCol,AgnObjSetCol,AgnObjCol, _ AgnObj,CpySetObj,AgnSetObj,button SetValue "preferences.Interaction.autoinspect", False Set SelObjCol = GetValue("SelectionList") If SelObjCol.Count = 0 Then MsgBox "適用対象Objを選択してください",,"Check" Else Set CpyObjSetCol = CreateObject("XSI.Collection") Set CpyObjSetCol = CreateObject("XSI.Collection") Set CpyObjCol = CreateObject("XSI.Collection") Set AgnObjSetCol = CreateObject("XSI.Collection") Set AgnObjCol = CreateObject("XSI.Collection") Set WarObjCol = CreateObject("XSI.Collection") For each SelObj in SelObjCol Set ChkPtyCol = CreateObject("XSI.Collection") ChkPtyCol.Items = SelObj & ".Ultimapper*" If ChkPtyCol.Count = 1 Then For each ChkPty in ChkPtyCol If ChkPty.name = "Ultimapper" Then CpyObjCol.Add SelObj Else WarObjCol.Add SelObj End if Next ElseIf ChkPtyCol.Count = 0 Then AgnObjCol.Add SelObj Else WarObjCol.Add SelObj End if Next If CpyObjCol.Count = 0 Then Else For each CpyObj in CpyObjCol Set ChkTxpCol = CreateObject("XSI.Collection") ChkTxpCol.Items = CpyObj & ".polymsh.cls.Texture_Coordinates_AUTO.Texture_Projection" If ChkTxpCol.Count = 0 Then WarObjCol.Add CpyObj Else Set ChkPtyCol = CreateObject("XSI.Collection") ChkPtyCol.Items = CpyObj & ".polymsh.cls.Texture_Coordinates_AUTO.Tangents*" If ChkPtyCol.Count = 1 Then Set TanOpCol = CreateObject("XSI.Collection") TanOpCol.Items = CpyObj & ".polymsh.cls.Texture_Coordinates_AUTO.Tangents.TangentOp2" If TanOpCol.Count = 0 Then WarObjCol.Add CpyObj Else CpyObjSetCol.Add CpyObj End if Else WarObjCol.Add CpyObj End if End if Next End if If AgnObjCol.Count = 0 Then Else For each AgnObj in AgnObjCol Set ChkTxpCol = CreateObject("XSI.Collection") ChkTxpCol.Items = AgnObj & ".polymsh.cls.Texture_Coordinates_AUTO.Texture_Projection" If ChkTxpCol.Count = 0 Then WarObjCol.Add AgnObj Else Set ChkPtyCol = CreateObject("XSI.Collection") ChkPtyCol.Items = AgnObj & ".polymsh.cls.Texture_Coordinates_AUTO.Tangents*" If ChkPtyCol.Count = 0 Then AgnObjSetCol.Add AgnObj Else WarObjCol.Add AgnObj End if End if Next End if PickObject "_", "_", TgtObj, button Set ChkPtyCol = CreateObject("XSI.Collection") ChkPtyCol.Items = TgtObj & ".Ultimapper*" If ChkPtyCol.Count = 1 Then For each ChkPty in ChkPtyCol If ChkPty.name = "Ultimapper" Then Sts_A = GetValue (TgtObj & ".Ultimapper.Group") Sts_B = GetValue (TgtObj & ".Ultimapper.MapPath") Sts_C = GetValue (TgtObj & ".Ultimapper.Prefix") Sts_D = GetValue (TgtObj & ".Ultimapper.Type") Sts_E = GetValue (TgtObj & ".Ultimapper.GenNormalT") Sts_F = GetValue (TgtObj & ".Ultimapper.GenAO") Sts_G = GetValue (TgtObj & ".Ultimapper.Resolution") Sts_H = GetValue (TgtObj & ".Ultimapper.SuperSampling") Sts_I = GetValue (TgtObj & ".Ultimapper.Distance") If CpyObjSetCol.Count = 0 Then Else For each CpySetObj in CpyObjSetCol SetValue CpySetObj & ".Ultimapper.Group", Sts_A SetValue CpySetObj & ".Ultimapper.MapPath", Sts_B SetValue CpySetObj & ".Ultimapper.Prefix", Sts_C SetValue CpySetObj & ".Ultimapper.Type", Sts_D SetValue CpySetObj & ".Ultimapper.GenNormalT", Sts_E SetValue CpySetObj & ".Ultimapper.GenAO", Sts_F SetValue CpySetObj & ".Ultimapper.Resolution", Sts_G SetValue CpySetObj & ".Ultimapper.SuperSampling", Sts_H SetValue CpySetObj & ".Ultimapper.Distance", Sts_I SetValue CpySetObj & ".Ultimapper.Tangent", "Tangents" Next End if If AgnObjSetCol.Count = 0 Then Else For each AgnSetObj in AgnObjSetCol AddProp "Ultimapper", AgnSetObj, siDefaultPropagation SetValue AgnSetObj & ".Ultimapper.Texcoord", "Texture_Projection" CreateVertexColorSupport "ColorAtVertices", "Tangents", AgnSetObj SetValue AgnSetObj & ".Ultimapper.Tangent", "Tangents" ApplyOp "TangentOp2_cpp", AgnSetObj & ".polymsh.cls.Texture_Coordinates_AUTO.Tangents;" & AgnSetObj & ".polymsh.cls.Texture_Coordinates_AUTO.Texture_Projection", siUnspecified, siPersistentOperation, , 2 SetValue CpySetObj & ".Ultimapper.Group", Sts_A SetValue CpySetObj & ".Ultimapper.MapPath", Sts_B SetValue CpySetObj & ".Ultimapper.Prefix", Sts_C SetValue CpySetObj & ".Ultimapper.Type", Sts_D SetValue CpySetObj & ".Ultimapper.GenNormalT", Sts_E SetValue CpySetObj & ".Ultimapper.GenAO", Sts_F SetValue CpySetObj & ".Ultimapper.Resolution", Sts_G SetValue CpySetObj & ".Ultimapper.SuperSampling", Sts_H SetValue CpySetObj & ".Ultimapper.Distance", Sts_I SetValue CpySetObj & ".Ultimapper.Tangent", "Tangents" Next End if If WarObjCol.Count = 0 Then Else SelectObj WarObjCol MsgBox "抽出されたこれらのObjは、重複設定または" & Chr(13) & Chr(10) & _ "理想でない結果になる可能性があります" & Chr(13) & Chr(10) & _ "その為処理を実行しませんでした",,"Check" End if Else MsgBox "設定情報取得対称は「Ultimapper」です" & Chr(13) & Chr(10) & _ "名前を確認してください",,"Check" End if Next Else MsgBox "PIC対称のObjがUltimapperを複数所持、または所持していない為" & Chr(13) & Chr(10) & _ "設定情報を取得できません",,"Check" End if End if