SUMCON
User Interface Package

Start Menu

$VersionSUMCON="1.2";

Start Menu

Start Menu

mod$StartSUMCON:=
CreateDialog[{
(*---Define Variables---*)
titleSUMCON=Import["SUMCON.PNG"];(*Import Title*)
tabviewctrl=1;(*Tabview Control Number*)
If[Not[ValueQ[calcdone]],calcdone=False];(*Calculated or not*)
(*---Top Frame---*)
TableForm[{{Image[titleSUMCON,ImageSize->300],(*Title Image*)
TableForm[{Style["SUMCON Version:"<>$VersionSUMCON,Bold,Italic,Black],(*Version*)
TableForm[{{
Button[Style["About SUMCON",Bold,Black],mod$AboutSUMCON,(*About SUMCON*)
Appearance->"FramedPalette",Background->White],
Button[Style["Version Info",Bold,Black],mod$VersionInfo,(*Version Info*)
Appearance->"FramedPalette",Background->Cyan],
Button[Style["Reflesh",Bold,White],DialogReturn[mod$StartSUMCON],(*Quit Button*)
Appearance->"FramedPalette",Background->Red]}}]
},TableAlignments->Left]
}}],
(*---Load Button---*)
TableForm[{{
Button[Style["New Model",Bold,Black],mod$NewModel,
Appearance->"FramedPalette",Background->White],
Button[Style["Load Model",Bold,White],mod$LoadModel,
Appearance->"FramedPalette",Background->Black],
Button[Style["Save Model",Bold,Black],mod$SaveModel,
Appearance->"FramedPalette",Background->Yellow],
Dynamic[If[ValueQ[save$FileName],
Style[save$FileName<>".m",Black],save$FileName;""]]}}],

TabView[{

(*--- ********** Model Construction ********** ---*)

Style["Model Construction",Bold]->TableForm[{
(*---1. Registrate Rigid Bodies---*)
Item[Pane[Style["Step 1. Registrate Rigid Bodies",
Bold,Italic,White],ImageSize->{870,30},Alignment->{Left,Center}],
Background->RGBColor[0,0,0.3]],"",
TableForm[{{
TableForm[{
(*Set Body Names*)
Button[Style["1-1 \nSet Body Names",Bold,Black],mod$SetBodyNames,
Appearance->"FramedPalette",Alignment->{Left,Center},
Background->RGBColor[0.6,0.6,1],ImageSize->200],
(*Set Mass & MoI*)
Button[Style["1-2 \nSet Mass & MoI",Bold,Black],mod$SetMassMoI,
Appearance->"FramedPalette",Alignment->{Left,Center},
Background->RGBColor[0.6,0.6,0.9],ImageSize->200],
(*Set Body Shapes*)
Button[Style["1-3 \nSet Body Shapes",Bold,Black],mod$SetBodyShapes,
Appearance->"FramedPalette",Alignment->{Left,Center},
Background->RGBColor[0.6,0.6,0.8],ImageSize->200],
(*Set Initial Position*)
Button[Style["1-4 \nSet Initial Position",Bold,Black],mod$SetInitPos,
Appearance->"FramedPalette",Alignment->{Left,Center},
Background->RGBColor[0.6,0.6,0.7],ImageSize->200]}
],
mod$ShowBodyList
}},TableAlignments->Top],"",

(*---2. Set Connection---*)
Item[Pane[Style["Step 2. Set Connection",
Bold,Italic,White],ImageSize->{870,30},Alignment->{Left,Center}],
Background->RGBColor[0,0.3,0]],"",
TableForm[{{
TableForm[{
(*Set Material*)
Button[Style["Set Material Properties",Bold,White,Small],mod$SetMaterial,
Appearance->"FramedPalette",Alignment->{Left,Center},
Background->RGBColor[0,0,0],ImageSize->Automatic],
(*Set Wires*)
Button[Style["2-1 \nSet Wires",Bold,Black],mod$SetWires,
Appearance->"FramedPalette",Alignment->{Left,Center},
Background->RGBColor[0.6,1,0.6],ImageSize->200],
Button[Style["2-2 \nSet Vertical Springs",Bold,Black],mod$SetVertSprings,(*Set Mass % MoI*)
Appearance->"FramedPalette",Alignment->{Left,Center},
Background->RGBColor[0.6,0.9,0.6],ImageSize->200],
Button[Style["2-3 \nSet Inverted Pendulum",Bold,Black],mod$SetIP,(*Set Body Shapes*)
Appearance->"FramedPalette",Alignment->{Left,Center},
Background->RGBColor[0.6,0.8,0.6],ImageSize->200],
Button[Style["2-4 \nSet Heat Links",Bold,Black],mod$SetHeatLinks,(*Set Body Shapes*)
Appearance->"FramedPalette",Alignment->{Left,Center},
Background->RGBColor[0.6,0.7,0.6],ImageSize->200],
Button[Style["2-5 \nSet Damper",Bold,Black],mod$SetDamper,(*Set Body Shapes*)
Appearance->"FramedPalette",Alignment->{Left,Center},
Background->RGBColor[0.6,0.6,0.6],ImageSize->200]}
],
mod$ShowConnectionList
}},TableAlignments->Top],"",

(*---3. Start Calculation ---*)
Item[Pane[Style["Step 3. Start Calculation",
Bold,Italic,White],ImageSize->{580,30},Alignment->{Left,Center}],
Background->RGBColor[0.3,0,0]],"",
TableForm[{{
Button[Style["Construct Model",Bold,White],
(mod$StartCalc;calcdone=True;tabviewctrl=2;),(*Set Body Names*)
Appearance->"FramedPalette",Alignment->Center,FrameMargins->10,
Background->RGBColor[0,0,0],ImageSize->200,Method->"Queued"]
}},TableAlignments->Center]
}],


(*--- ********** Calculation Result ********** ---*)
Style["Calculation Result",Bold]->
Dynamic[If[Not[calcdone],calcdone;"",
calcdone;
TableForm[{
(*---Basic Info---*)
Item[Pane[Style["Model Basic Information",
Bold,Italic,White],ImageSize->{870,30},Alignment->{Left,Center}],
Background->RGBColor[0.5,0,0]],"",
TableForm[{{
TableForm[{
{TableForm[{{Style["Degrees of Freedom:",Bold]}}]},
{TableForm[{{Length[allvars],"State Variables"},
{Length[allparams],"Input Variables"},
{Length[allfloats],"Float Variables"}}]},
{""},
{Style["Ground Position:",Bold]},
{Pane[TableForm[Partition[makesub[allparams,
Round[allparams/.subdefparams,0.0001]],6,6,1,{}]]]
},
{""},
{Style["Equilibrium Point:",Bold]},
{Pane[TableForm[Partition[makesub[Join[allvars,allfloats],
Round[Join[allvars,allfloats]/.subminvars,0.0001]],6,6,1,{}]]]
}}],
steadyplot[subminvars,ViewPoint->{10,10,50},ViewVertical->{0,1,0},ImageSize->{200,400}]
}},TableAlignments->Top],"",

(*---Freq Plot Tool---*)
(*symbol setting*)
If[Not[ValueQ[calc$tfk]],calc$tfk=1];
calc$tfFi=Table[False,{Length[allvars]}];calc$tfFo=Table[False,{Length[allvars]}];
calc$tfGi=Table[False,{Length[allparams]}];calc$tfGo=Table[False,{Length[allvars]}];
calc$sni=Table[False,{Length[allparams]}];calc$sno=Table[False,{Length[allvars]}];
If[Not[ValueQ[calc$tnT]],calc$tnT=300];
calc$tnb=Table[False,{Length[allvars]}];
If[Not[ValueQ[fmin]],fmin=0.01];
If[Not[ValueQ[fmax]],fmax=100.];
If[Not[ValueQ[ngrid]],ngrid=1001];
If[Not[ValueQ[fgridtype]],fgridtype=True];
If[Not[ValueQ[calc$tfplot]],calc$tfplot={}];
If[Not[ValueQ[calc$psdplot]],calc$psdplot={}];
If[Not[ValueQ[calc$tfname]],calc$tfname={}];
If[Not[ValueQ[calc$psdname]],calc$psdname={}];
If[Not[ValueQ[calc$tfsel]],calc$tfsel={}];
If[Not[ValueQ[calc$psdsel]],calc$psdsel={}];
If[Not[ValueQ[calc$tfshow]],calc$tfshow={}];
If[Not[ValueQ[calc$psdshow]],calc$psdshow={}];
If[Not[ValueQ[calc$tfline]],calc$tfline={}];
If[Not[ValueQ[calc$psdline]],calc$psdline={}];

(*title*)
Item[Pane[Style["Frequency Domain Plot Tool",
Bold,Italic,White],ImageSize->{870,30},Alignment->{Left,Center}],
Background->RGBColor[0,0.5,0]],"",

(*choose mode*)
TableForm[{
Panel[
TableForm[{{PopupMenu[Dynamic[calc$tfk],
{1->"Frequency Responce to External Force/Torque",
2->"Frequency Responce to Ground Motion",
3->"Seismic Noise Plot",4->"Thermal Noise Plot"}],
Dynamic[
Button[Style["Set Seismic Spectrum",Bold,RGBColor[1,1,1]],mod$SetSeism,
Appearance->"FramedPalette",Background->If[calc$tfk==3,GrayLevel[0.1],GrayLevel[0.7]],
Enabled->calc$tfk==3]]
}},TableAlignments->{Left,Center}],ImageSize->850,FrameMargins->5],

calc$combif=False;
If[Not[ValueQ[calc$combin]],calc$combin={allvars[[1]]+allvars[[2]],allvars[[1]]-allvars[[2]]}];

(*Select Input or temp*)
Dynamic[
Panel[
PaneSelector[
{1->TableForm[{{Style["Input:",Bold],
TableForm[Partition[Table[TableForm[{{
Checkbox[With[{n=n},Dynamic[calc$tfFi[[n]]]]],
ToString[allvars[[n]]]}}],{n,Length[allvars]}],
6,6,1,{}]],
TableForm[{
TableForm[{{Checkbox[Dynamic[calc$combif]],Style["Combined Input:"]}}],
InputField[Dynamic[calc$combin],FieldSize->{20.,3.}]
}]

}},TableAlignments->{Left,Center}],
2->TableForm[{{Style["Input:",Bold],
TableForm[Partition[Table[TableForm[{{
Checkbox[With[{n=n},Dynamic[calc$tfGi[[n]]]]],
ToString[allparams[[n]]]}}],{n,Length[allparams]}],
6,6,1,{}]]}},TableAlignments->{Left,Center}],
3->TableForm[{{Style["Input:",Bold],
TableForm[Partition[Table[TableForm[{{
Checkbox[With[{n=n},Dynamic[calc$sni[[n]]]]],
ToString[allparams[[n]]]}}],{n,Length[allparams]}],
6,6,1,{}]],
Button[Style["Add Seismic Spectrum Plot",Bold,RGBColor[0,0,0]],mod$AddSeismPlot,
Appearance->"FramedPalette",Background->GrayLevel[1.]]
}},
TableAlignments->{Left,Center}],
4->TableForm[{{Style["Temperature:",Bold],
InputField[Dynamic[calc$tnT],Number,FieldSize->{5.,1.}],"K"
}},TableAlignments->{Left,Center}]},calc$tfk,ImageSize->Automatic],ImageSize->850,FrameMargins->5]],

(*Select output*)
Dynamic[
Panel[
PaneSelector[
{1->TableForm[{{Style["Output:",Bold],
TableForm[Partition[Table[TableForm[{{
Checkbox[With[{n=n},Dynamic[calc$tfFo[[n]]]]],
ToString[allvars[[n]]]}}],{n,Length[allvars]}],
6,6,1,{}]]}},TableAlignments->Top],
2->TableForm[{{Style["Output:",Bold],
TableForm[Partition[Table[TableForm[{{
Checkbox[With[{n=n},Dynamic[calc$tfGo[[n]]]]],
ToString[allvars[[n]]]}}],{n,Length[allvars]}],
6,6,1,{}]]}},TableAlignments->Top],
3->TableForm[{{Style["Output:",Bold],
TableForm[Partition[Table[TableForm[{{
Checkbox[With[{n=n},Dynamic[calc$sno[[n]]]]],
ToString[allvars[[n]]]}}],{n,Length[allvars]}],
6,6,1,{}]]}},TableAlignments->Top],
4->TableForm[{{Style["Output:",Bold],
TableForm[Partition[Table[TableForm[{{
Checkbox[With[{n=n},Dynamic[calc$tnb[[n]]]]],
ToString[allvars[[n]]]}}],{n,Length[allvars]}],
6,6,1,{}]]}},TableAlignments->Top]
},calc$tfk,ImageSize->Automatic],ImageSize->850,FrameMargins->5]],

(*Frequency setup*)
TableForm[{{
Panel[TableForm[{{
Style["Frequency:",Bold],InputField[Dynamic[fmin],Number,FieldSize->{5.,1.}],"-",
InputField[Dynamic[fmax],Number,FieldSize->{5.,1.}],"Hz"}}],
ImageSize->300,FrameMargins->5],
Panel[TableForm[{{
Style["Step:",Bold],InputField[Dynamic[ngrid],Number,FieldSize->{5.,1.}],
Checkbox[Dynamic[fgridtype]],"Logarithmic",
Checkbox[Dynamic[Not[fgridtype],(fgridtype=Not[#])&]],"Linear"
}}],
ImageSize->542,FrameMargins->5]
}}],

(*Set symbol and options*)
If[Not[ValueQ[calc$xrange]],calc$xrange=Automatic];
If[Not[ValueQ[calc$yrange]],calc$yrange=Automatic];
amplabel="Amplitude";
If[Not[ValueQ[calc$lgndpos]],calc$lgndpos={0.35,0.3}];
If[Not[ValueQ[calc$legend]],calc$legend=True];

(*Plot*)
TableForm[{{
Dynamic[
Panel[
PaneSelector[
{True->
TableForm[{
(*More Button*)
Button[Style["Open New Window",Small,Bold],
CreateDocument[
{ExpressionCell[
TableForm[{
ListLogLogPlot[takemag[calc$tfplot,calc$tfshow],
Join[
If[calc$legend&&Not[Length[calc$tfname]==0]&&MemberQ[calc$tfshow,True],
{PlotLegend->DeleteCases[Table[If[calc$tfshow[[n]],calc$tfname[[n]]],
{n,Length[calc$tfname]}],Null],LegendShadow->None,LegendSpacing->0,
LegendTextSpace->2.5,LegendSpacing->0,LegendPosition->calc$lgndpos,
LegendSize->{0.2+0.023*Max[Table[StringLength[calc$tfname[[n]]],
{n,Length[calc$tfname]}]],0.08*Sum[If[calc$tfshow[[n]],1,0],
{n,Length[calc$tfname]}]}},{}],
baseoptmag,{PlotRange->{calc$xrange,calc$yrange},
PlotStyle->If[Length[calc$tfline]==0,Thick,calc$tfline]}]],
ListLogLinearPlot[takephs[calc$tfplot,calc$tfshow],
Join[baseoptphs,{PlotRange->{calc$xrange,{-180,180}},
PlotStyle->If[Length[calc$tfline]==0,Thick,calc$tfline]}]]
}]
]}
],Appearance->"FramedPalette",Background->GrayLevel[0.8],ImageSize->Small,Method->"Queued"],

ListLogLogPlot[takemag[calc$tfplot,calc$tfshow],
Join[
If[calc$legend&&Not[Length[calc$tfname]==0]&&MemberQ[calc$tfshow,True],
{PlotLegend->DeleteCases[Table[If[calc$tfshow[[n]],calc$tfname[[n]]],
{n,Length[calc$tfname]}],Null],LegendShadow->None,LegendSpacing->0,
LegendTextSpace->2.5,LegendSpacing->0,LegendPosition->calc$lgndpos,
LegendSize->{0.2+0.023*Max[Table[StringLength[calc$tfname[[n]]],
{n,Length[calc$tfname]}]],0.08*Sum[If[calc$tfshow[[n]],1,0],
{n,Length[calc$tfname]}]}},{}],
baseoptmag,{PlotRange->{calc$xrange,calc$yrange},
PlotStyle->If[Length[calc$tfline]==0,Thick,calc$tfline]}]],
ListLogLinearPlot[takephs[calc$tfplot,calc$tfshow],
Join[baseoptphs,{PlotRange->{calc$xrange,{-180,180}},
PlotStyle->If[Length[calc$tfline]==0,Thick,calc$tfline]}]]}],

False->
TableForm[{
(*More Button*)
Button[Style["Open New Window",Small,Bold],
CreateDocument[
{ExpressionCell[
ListLogLogPlot[takepsd[calc$psdplot,calc$psdshow],Join[
If[calc$legend&&Not[Length[calc$psdname]==0]&&MemberQ[calc$psdshow,True],
{PlotLegend->DeleteCases[Table[If[calc$psdshow[[n]],calc$psdname[[n]]],
{n,Length[calc$psdname]}],Null],LegendShadow->None,LegendSpacing->0,
LegendTextSpace->2.5,LegendSpacing->0,LegendPosition->calc$lgndpos,
LegendSize->{0.2+0.023*Max[Table[StringLength[calc$psdname[[n]]],
{n,Length[calc$psdname]}]],0.08*Sum[If[calc$psdshow[[n]],1,0],
{n,Length[calc$psdname]}]}},{}],
baseoptpsd,{PlotRange->{calc$xrange,calc$yrange},
PlotStyle->If[Length[calc$psdline]==0,Thick,calc$psdline]}]]
]}
],Appearance->"FramedPalette",Background->GrayLevel[0.8],ImageSize->Small,Method->"Queued"],

ListLogLogPlot[takepsd[calc$psdplot,calc$psdshow],Join[
If[calc$legend&&Not[Length[calc$psdname]==0]&&MemberQ[calc$psdshow,True],
{PlotLegend->DeleteCases[Table[If[calc$psdshow[[n]],calc$psdname[[n]]],
{n,Length[calc$psdname]}],Null],LegendShadow->None,LegendSpacing->0,
LegendTextSpace->2.5,LegendSpacing->0,LegendPosition->calc$lgndpos,
LegendSize->{0.2+0.023*Max[Table[StringLength[calc$psdname[[n]]],
{n,Length[calc$psdname]}]],0.08*Sum[If[calc$psdshow[[n]],1,0],
{n,Length[calc$psdname]}]}},{}],
baseoptpsd,{PlotRange->{calc$xrange,calc$yrange},
PlotStyle->If[Length[calc$psdline]==0,Thick,calc$psdline]}]]


}]
},calc$tfk==1||calc$tfk==2,ImageSize->Automatic],ImageSize->510]],

(*Set temp symbol*)
If[Not[ValueQ[temp$xrange]],temp$xrange={0.01,100.}];
If[Not[ValueQ[temp$yrange]],temp$yrange={1.*10^(-10),1.*10^(2)}];

(*Add and clear button*)
TableForm[{
Panel[
TableForm[{
TableForm[{{
Button[Style["Add Plot",Bold,Black],mod$CalcFreqPlot,
Appearance->"FramedPalette",Background->GrayLevel[0.8],Method->"Queued"],
Button[Style["Clear Plot",Bold,White],
If[calc$tfk==1||calc$tfk==2,
calc$tfplot={};calc$tfname={};calc$tfsel={};calc$tfshow={};calc$tfline={},
calc$psdplot={};calc$psdname={};calc$psdsel={};calc$psdshow={};calc$psdline={}],
Appearance->"FramedPalette",Background->Red]
}}]}],ImageSize->332],

(*Apearance setting*)
Panel[
TableForm[{
TableForm[{{
Checkbox[Dynamic[calc$legend]],"Show Legend"
}}],
TableForm[{
{Button[Style["Set x-range",Bold,White,Small],
If[Length[temp$xrange]==2&&temp$xrange[[1]]<temp$xrange[[2]],
calc$xrange=temp$xrange],
Appearance->"FramedPalette",ImageSize->Small,Background->RGBColor[0,0.2,0]],
InputField[Dynamic[temp$xrange],FieldSize->{18.,1.}],
Button[Style["Auto",Bold,Black,Small],
calc$xrange=Automatic,
Appearance->"FramedPalette",ImageSize->Small,Background->GrayLevel[0.8]]
},
{Button[Style["Set y-range",Bold,White,Small],
If[Length[temp$yrange]==2&&temp$yrange[[1]]<temp$yrange[[2]],
calc$yrange=temp$yrange],
Appearance->"FramedPalette",ImageSize->Small,Background->RGBColor[0,0,0.2]],
InputField[Dynamic[temp$yrange],FieldSize->{18.,1.}],
Button[Style["Auto",Bold,Black,Small],
calc$yrange=Automatic,
Appearance->"FramedPalette",ImageSize->Small,Background->GrayLevel[0.8]]}}]

}],ImageSize->332],

(*graph name list*)
Dynamic[
Panel[
TableForm[{
Pane[PaneSelector[
{True->TableForm[Table[{
Checkbox[With[{n=n},Dynamic[calc$tfsel[[n]]]]],
InputField[With[{n=n},Dynamic[calc$tfname[[n]]]],String,
FieldSize->{18.,1.},Background->If[calc$tfshow[[n]],White,Gray]],
With[{n=n},Button[Style["Line Style",Bold,Black,Small],mod$FPLineStyle[n],
Appearance->"FramedPalette",ImageSize->Small,Background->GrayLevel[0.8]]]
},{n,Length[calc$tfplot]}],TableHeadings->None],
False->TableForm[Table[{
Checkbox[With[{n=n},Dynamic[calc$psdsel[[n]]]]],
InputField[With[{n=n},Dynamic[calc$psdname[[n]]]],String,
FieldSize->{18.,1.},Background->If[calc$psdshow[[n]],White,Gray]],
With[{n=n},Button[Style["Line Style",Bold,Black,Small],mod$FPLineStyle[n],
Appearance->"FramedPalette",ImageSize->Small,Background->GrayLevel[0.8]]]
},{n,Length[calc$psdplot]}],TableHeadings->None]
},calc$tfk==1||calc$tfk==2]
,Scrollbars->True,ImageSize->{310,230},AppearanceElements->None],
TableForm[{{
Button[Style["Sum",Bold,Black],mod$FPSum,
Appearance->"FramedPalette",Background->RGBColor[0.7,1,0.7]],
Button[Style["x Factor",Bold,Black],mod$FPFactor,
Appearance->"FramedPalette",Background->RGBColor[1,0.7,0.7]],
Button[Style["Inverse",Bold,Black],mod$FPInverse,
Appearance->"FramedPalette",Background->RGBColor[0.7,0.7,1]],
Button[Style["Multiply",Bold,Black],mod$FPMultiply,
Appearance->"FramedPalette",Background->RGBColor[1,0.5,1]],
Button[Style["RMS",Bold,Black],mod$FPRMS,
Appearance->"FramedPalette",Background->RGBColor[1,1,0.7]]
}}],
TableForm[{{
Button[Style["Hide",Bold,White],mod$FPHide,
Appearance->"FramedPalette",Background->GrayLevel[0.2]],
Button[Style["Show",Bold,White],mod$FPShow,
Appearance->"FramedPalette",Background->RGBColor[0,0.5,0]],
Button[Style["Delete",Bold,White],mod$FPDelete,
Appearance->"FramedPalette",Background->Red],
Button[Style["Save",Bold,White],mod$FPSave,
Appearance->"FramedPalette",Background->Blue],
Button[Style["Load",Bold,White],mod$FPLoad,
Appearance->"FramedPalette",Background->Black]
}}],
TableForm[{{
Button[Style["Export",Bold,White],mod$FPExport,
Appearance->"FramedPalette",Background->RGBColor[0.2,0,0.5]],
Button[Style["Import",Bold,White],mod$FPImport,
Appearance->"FramedPalette",Background->RGBColor[0.5,0,0.2]]
}}]
}],ImageSize->332]]
}]
}},TableAlignments->Top]
}],"",

(*---Eigen Plot---*)
If[Not[ValueQ[calc$eigenTA]],calc$eigenTA=0.2];
If[Not[ValueQ[calc$eigenPA]],calc$eigenPA=0.5];
If[Not[ValueQ[calc$eigenIS]],calc$eigenIS=150];
If[Not[ValueQ[calc$eigenP]]||Not[Length[calc$eigenP]==Length[eigenf]],
calc$eigenP=Table[False,{Length[eigenf]}]];
If[Not[ValueQ[temp$eigenP]]||Not[Length[temp$eigenP]==Length[eigenf]],
temp$eigenP=Table[False,{Length[eigenf]}]];
If[Not[ValueQ[calc$maxx]],calc$maxx=2.5];If[Not[ValueQ[calc$maxz]],calc$maxz=2.5];
If[Not[ValueQ[calc$ytop]],calc$ytop=1.0];If[Not[ValueQ[calc$ybottom]],calc$ybottom=-2.5];

Item[Pane[Style["Eigen Modes",
Bold,Italic,White],ImageSize->{870,30},Alignment->{Left,Center}],
Background->RGBColor[0,0,0.5]],"",

Dynamic[
Panel[
TableForm[{
TableForm[{{Style["Eigen Mode List",Bold,RGBColor[0,0,0.3]],
"(Threshold Amplitude:",InputField[Dynamic[calc$eigenTA],Number,FieldSize->{5.,1.}],")"}}],
Pane[eigenmodetable[eigenf,eigenv,calc$eigenTA],
Scrollbars->True,ImageSize->{832,150},AppearanceElements->None]
}]
]],
TableForm[{{
Panel[
TableForm[{
TableForm[{{Style["Eigen Mode 3D Plot",Bold,RGBColor[0.3,0,0]],
Button[Style["Show",Small,Bold,White],calc$eigenP=temp$eigenP,
Appearance->"FramedPalette",Background->GrayLevel[0.1],ImageSize->Small,Method->"Queued"]
}}],
TableForm[Partition[Table[TableForm[{{
Checkbox[With[{n=n},Dynamic[temp$eigenP[[n]]]]],ToString[n]}}],{n,Length[eigenf]}],
6,6,1,{}]]}],ImageSize->450
],
Panel[
TableForm[{
TableForm[
{{Style["Amplitude:",Bold],InputField[Dynamic[calc$eigenPA],Number,FieldSize->{5.,1.}],"",
Style["Image Size:",Bold],InputField[Dynamic[calc$eigenIS],Number,FieldSize->{5.,1.}]}}],
Style["Marker Position:",Bold],
TableForm[
{{Style["x:",Bold],InputField[Dynamic[calc$maxx],Number,FieldSize->{3.,1.}],
Style["z:",Bold],InputField[Dynamic[calc$maxz],Number,FieldSize->{3.,1.}],
Style["y+:",Bold],InputField[Dynamic[calc$ytop],Number,FieldSize->{3.,1.}],
Style["y-:",Bold],InputField[Dynamic[calc$ybottom],Number,FieldSize->{3.,1.}]}}]
}]

,ImageSize->392]
}},TableHeadings->Top],

Dynamic[
Panel[
If[Not[DeleteCases[Table[If[calc$eigenP[[l]],l,0],{l,Length[eigenf]}],0]==={}],
TableForm[
Partition[
Table[
TableForm[{
TableForm[{{Style[ToString[Round[eigenf[[n]],0.001]]<>"Hz",15],
With[{n=n},Button[Style["More",Small,Bold],
CreateDocument[
{ExpressionCell[eigenplot[eigenv,calc$eigenPA,n,ImageSize->calc$eigenIS]]}
],Appearance->"FramedPalette",Background->GrayLevel[0.8],ImageSize->Small,Method->"Queued"]]
}}],
eigenplot[eigenv,calc$eigenPA,n,ImageSize->calc$eigenIS,
If[viewQ[important[eigenv[[n]]][[1]]],optr,optp]]}],
{n,DeleteCases[Table[If[calc$eigenP[[l]],l,0],{l,Length[eigenf]}],0]}],
IntegerPart[840/(calc$eigenIS+10)],IntegerPart[840/(calc$eigenIS+10)],1,{}]
],"3D plots are shown here."],ImageSize->850
]
],""

}]]],

(*--- ********** Export Model ********** ---*)
Style["Export Model",Bold]->
Dynamic[
If[Not[calcdone],calcdone;"",

calcdone;
TableForm[{
(*---Export---*)
Item[Pane[Style["Mathematica Export",
Bold,Italic,White],ImageSize->{870,30},Alignment->{Left,Center}],
Background->RGBColor[0.2,0.1,0.1]],"",
Style["Export matrices and variables in Mathematica Format:",Bold],
TableForm[{{
Button[Style["Export Suspension Model",Bold,White],
mod$ExportModel,(*Set Body Names*)
Appearance->"FramedPalette",Alignment->Center,FrameMargins->10,
Background->RGBColor[0.2,0,0],ImageSize->200,Method->"Queued"]
}},TableAlignments->Center],"","",

Item[Pane[Style["MATLAB Export",
Bold,Italic,White],ImageSize->{870,30},Alignment->{Left,Center}],
Background->RGBColor[0.1,0.2,0.1]],"",
Style["Export ABCD matrices in a format that can be read in MATLAB:",Bold],
TableForm[{{
Button[Style["Export Suspension Model",Bold,White],
mod$MATLABExport,(*Set Body Names*)
Appearance->"FramedPalette",Alignment->Center,FrameMargins->10,
Background->RGBColor[0,0.2,0],ImageSize->200,Method->"Queued"]
}},TableAlignments->Center]
}]
]]

},Dynamic[tabviewctrl]]

},
WindowFrameElements->{"CloseBox","ResizeArea","ZoomBox","MinimizeBox"},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{920,600},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"SUMCON Version:"<>$VersionSUMCON
];

Information

About SUMCON

mod$AboutSUMCON:=CreateDialog[
{titleSUMCON=Import["SUMCON.PNG"];(*Import Title*)
(*---Top Frame---*)
TableForm[{
Image[titleSUMCON,ImageSize->400],
"",
"(You need Wolfram Mathematica later than version 7.0)",
"Suspension Model Constructor",
"Version:"<>$VersionSUMCON,
"",
"Programmed by Takanori Sekiguchi",
"Contact: tseki@icrr.u-tokyo.ac.jp",
"",
"Last Update: 28/08/2013",
DefaultButton[]},TableAlignments->Center]},WindowTitle->"SUMCON"];

Version Info

mod$VersionInfo:=CreateDialog[
{titleSUMCON=Import["SUMCON.PNG"];(*Import Title*)
(*---Top Frame---*)
TableForm[{
Image[titleSUMCON,ImageSize->400],
Pane[
TableForm[{
Style["v1.2 Release (13/10/2013)",Bold,RGBColor[0.4,0,0]],
"* Fix bugs for newly introduced functions in v1.1.",
"* Introduce 'Import' button to the 'Frequency Domain Plot Tools'",
"",
Style["v1.1 Release (16/08/2013)",Bold,RGBColor[0.4,0,0]],
"* Introduce the Tab-View interface.",
"* Add 'Export' button to the 'Frequency Domain Plot Tools'",
"* Add 'Export Model' section for other applications.",
"* Fix bugs for Macintosh users.",
"",
Style["v1.0 Release (22/03/2013)",Bold,RGBColor[0.4,0,0]],
"* Beta version released."
},TableAlignments->{Left,Top}],Alignment->Left,ImageSize->400],
DefaultButton[]},TableAlignments->Center]},WindowTitle->"Version Information"];

Save & Load Model

Save Function

mod$ListSave[file_,list_]:=Do[Save[file,Evaluate[list[[n]]]],{n,Length[list]}];

Save Model

mod$SaveModel:=
CreateDialog[{
sepchar=StringTake[FileNames["*.m",{"save"},3][[1]],{5}];
temp$saveQ=False;
saveparamnames=Join[Names["save$*"],Names["calc$*"],Names["matK@"],Names["matG@"],Names["matM@"],
{"allvars","allparams","allfloats","subdefparams","subminvars","eigenf","eigenv","bodylist","wirelist","calcdone"}];

TextCell[Style["Save Model",
Bold,Italic,White],Background->RGBColor[0,0,0]],
Style["Saved Parameters:",Bold,Italic],
Grid[Partition[saveparamnames,7,7,1,{}],Background->White],
Style["File Name:",Bold,Italic],
TableForm[{{InputField[Dynamic[temp$FileName],String,FieldSize->{30.,1.}],
Button[Style["Save",Bold,White],
If[Not[StringLength[temp$FileName]==0],
If[MemberQ[FileNames["*.m",{"save"},3],"save"<>sepchar<>temp$FileName<>".m"],
temp$saveQ=True,save$FileName=temp$FileName;
(*Save[Directory[]<>"/save"<>sepchar<>save$FileName<>".m",saveparamlist];*)
mod$ListSave[Directory[]<>"/save"<>sepchar<>save$FileName<>".m",saveparamnames];
DialogReturn[]]],Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],Appearance->"FramedPalette",Background->GrayLevel[.8]]
}}],
Dynamic[PaneSelector[{True->
TableForm[{{Style["Do you really want to overwrite?",Red,Bold],
Button[Style["Yes",Bold,Small,White],
DialogReturn[
save$FileName=temp$FileName;
DeleteFile[Directory[]<>"/save"<>sepchar<>save$FileName<>".m"];
(*Save[Directory[]<>"/save"<>sepchar<>save$FileName<>".m",saveparamlist]],*)
mod$ListSave[Directory[]<>"/save"<>sepchar<>save$FileName<>".m",saveparamnames]],
Appearance->"FramedPalette",Background->RGBColor[1,0,0]],
Button[Style["No",Bold,Small,Black],temp$saveQ=False,
Appearance->"FramedPalette",Background->White]
}}],False->Null},temp$saveQ,ImageSize->Automatic]],
Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.m",{"save"},3][[n]],5],
temp$FileName=StringDrop[StringDrop[FileNames["*.m",{"save"},3][[n]],5],-2],
Appearance->"Frameless",Alignment->Left,ImageSize->200]]
,{n,Length[FileNames["*.m",{"save"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{650,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,650},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Save Model"
];

Load Model

mod$LoadModel:=
CreateDialog[{
(* ***********************Version 1.1******************************** *)
sepchar=StringTake[FileNames["*.m",{"save"},3][[1]],{5}];
(* ***********************Version 1.1******************************** *)
TextCell[Style["Load Model",
Bold,Italic,White],Background->RGBColor[0,0,0]],
Style["File Name:",Bold,Italic],
TableForm[{{InputField[Dynamic[temp$Load],String,FieldSize->{30.,1.},Enabled->False],
Button[Style["Load",Bold,White],
DialogReturn[If[Not[StringLength[temp$Load]==0],Get[Directory[]<>"/save"<>sepchar<>temp$Load<>".m"]]],
Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],
Appearance->"FramedPalette",Background->GrayLevel[.8]]}}],
Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.m",{"save"},3][[n]],5],
temp$Load=StringDrop[StringDrop[FileNames["*.m",{"save"},3][[n]],5],-2],
Appearance->"Frameless",Alignment->Left,ImageSize->200]]
,{n,Length[FileNames["*.m",{"save"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{650,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,500},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Load Model"
];

New Model

mod$NewModel:=CreateDialog[
{"Do you want to clear all the setting and start a new model?",
TableForm[{{Button[Style["OK",Bold],DialogReturn[(calcdone=False;Clear["save$*","calc$*"];)]],
Button["Cancel",DialogReturn[]]}}]
},WindowTitle->"New Model"];

1. Registrate Bodies

1-1 Set Body Names

Set Body Names

mod$SetBodyNames:=
CreateDialog[{
(*---Title---*)
TextCell[Style["Registrate Body Names",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,1]],
(*---Load List---*)
Module[{nMax=30,len},
If[ValueQ[save$bdn],len=Length[save$bdn];
If[len<nMax,(*If saved list exists, load it*)
temp$bdn=Join[save$bdn,Table[{False,""},{nMax-len}]],
temp$bdn=save$bdn[[1;;nMax]]],(*If not, create new one*)
temp$bdn=Join[{{True,"g"}},Table[{False,""},{nMax-1}]]];
(*---Input Field Module---*)
TableForm[
Partition[
Flatten[
Table[
{Checkbox[With[{n=n},Dynamic[temp$bdn[[n,1]]]]],
InputField[With[{n=n},Dynamic[temp$bdn[[n,2]]]],String,FieldSize->{5.,1.}]},
{n,nMax}],1],10,10,1,{}],TableAlignments->Center,
TableHeadings->{None,Flatten[Table[{"GND","Name"},{5}],1]}]],
(*---Save & Cancel Button---*)
TableForm[{{
Button[Style["Save",Bold],DialogReturn[(*Save Button*)
save$bdn=DeleteCases[DeleteCases[temp$bdn,{False,""}],{True,""}]]],
Button["Cancel",DialogReturn[]]}}]},(*Cancel Button*)
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->Automatic,WindowTitle->"1-1 Set Body Names"];

1-2 Set Mass and MoI

Set Mass and Moment of Inertia

mod$SetMassMoI:=
(*---Check Previous Setting---*)
If[Not[ValueQ[save$bdn]],(*If body names have not been set yet, return error*)
Beep[];CreateDialog[{"Set Body Name First.",DefaultButton[]},WindowTitle->"Error"];,
(*---Main Dialog---*)
CreateDialog[{
(*---Title---*)
TextCell[Style["Set Mass and Moment of Inertia",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.9]],
(*---Load List---*)
Module[{len0=Length[save$bdn],len},
If[ValueQ[save$mass],len=Length[save$mass];
If[len<len0,(*If saved list exists, load it*)
temp$mass=Join[save$mass,Table[{0,ConstantArray[0,{3,3}]},{len0-len}]],
temp$mass=save$mass[[1;;len0]]],(*If not, create new one*)
temp$mass=Table[{0,ConstantArray[0,{3,3}]},{len0}]];
(*---Logic List for Opener---*)
temp$massopn=Table[False,{len0}];
(*---Input Field Module---*)
TableForm[
Table[{
(*Copy & Past*)
With[{n=n},Button[Style["Copy",Small],
temp$masscopy=temp$mass[[n]],ImageSize->Small]],
With[{n=n},Button[Style["Paste",Small],
If[ValueQ[temp$masscopy],temp$mass[[n]]=temp$masscopy],ImageSize->Small]],
(*Mass & Diagonal MoI*)
InputField[With[{n=n},Dynamic[temp$mass[[n,1]]]],
Number,FieldSize->{5.,1.},Enabled->Not[save$bdn[[n,1]]]],
InputField[With[{n=n},Dynamic[temp$mass[[n,2,1,1]]]],
Number,FieldSize->{5.,1.},Enabled->Not[save$bdn[[n,1]]]],
InputField[With[{n=n},Dynamic[temp$mass[[n,2,2,2]]]],
Number,FieldSize->{5.,1.},Enabled->Not[save$bdn[[n,1]]]],
InputField[With[{n=n},Dynamic[temp$mass[[n,2,3,3]]]],
Number,FieldSize->{5.,1.},Enabled->Not[save$bdn[[n,1]]]],
(*MoI Off-Diangonal Part*)
Opener[With[{n=n},Dynamic[temp$massopn[[n]]]]],PaneSelector[{
False->"Off-Diag",
True->TableForm[Table[InputField[With[{n=n,m=m,l=l},
Dynamic[temp$mass[[n,2,m,l]]]],Number,ImageSize->70.,FieldSize->{5.,1.},Enabled->Not[save$bdn[[n,1]]]],{l,3},{m,3}],
TableHeadings->{{"x","y","z"},{"x","y","z"}}]},
With[{n=n},Dynamic[temp$massopn[[n]]]],ImageSize->Automatic]},
{n,len0}],TableHeadings->{Table[save$bdn[[n,2]],{n,len0}],
{"Copy","Paste","Mass","Ixx","Iyy","Izz","","I Matrix"}}]],
(*---Save & Cancel Button---*)
TableForm[{{
Button[Style["Save",Bold],
(*If mass & MoI diagonals are not positive number, return Error*)
If[MemberQ[Table[save$bdn[[n,1]]||(
If[NumericQ[temp$mass[[n,1]]],Positive[temp$mass[[n,1]]],False]&&
If[NumericQ[temp$mass[[n,2,1,1]]],Positive[temp$mass[[n,2,1,1]]],False]&&
If[NumericQ[temp$mass[[n,2,2,2]]],Positive[temp$mass[[n,2,2,2]]],False]&&
If[NumericQ[temp$mass[[n,2,3,3]]],Positive[temp$mass[[n,2,3,3]]],False]&&
NumericQ[temp$mass[[n,2,1,2]]]&&NumericQ[temp$mass[[n,2,1,3]]]&&
NumericQ[temp$mass[[n,2,2,1]]]&&NumericQ[temp$mass[[n,2,2,3]]]&&
NumericQ[temp$mass[[n,2,3,1]]]&&NumericQ[temp$mass[[n,2,3,2]]]),
{n,Length[temp$mass]}],False],
Beep[];CreateDialog[
{"Mass and diagnal parts of MoI matrices should be positive number.",
DefaultButton[]},WindowTitle->"Error"];,
DialogReturn[save$mass=temp$mass]]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},(*Cancel Button*)
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,500},WindowTitle->"1-2 Set Mass & MoI"];
];

1-3 Set Body Shapes

Create 3D shapes in the module

mod$Create3DShapeEx[shp_,dim_]:={mod$Create3DShape[{0,0,0},shp,dim],
Point[{+0.5,+0.5,+0.5}],
Point[{-0.5,+0.5,+0.5}],
Point[{+0.5,+0.5,-0.5}],
Point[{-0.5,+0.5,-0.5}],
Point[{+0.5,-0.5,+0.5}],
Point[{-0.5,-0.5,+0.5}],
Point[{+0.5,-0.5,-0.5}],
Point[{-0.5,-0.5,-0.5}],
Point[{+0.0,+0.0,+0.0}]
};

Set Body Shapes

mod$SetBodyShapes:=
(*---Check Previous Setting---*)
If[Not[ValueQ[save$bdn]],(*If body names have not been set yet, return error*)
Beep[];CreateDialog[{"Set Body Name First.",DefaultButton[]},WindowTitle->"Error"];,
(*---Main Dialog---*)
CreateDialog[{
(*---Title---*)
TextCell[Style["Set Appearance of Bodies",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.8]],
(*---Load List---*)
Module[{len0=Length[save$bdn],len},
If[ValueQ[save$shape],len=Length[save$shape];
If[len<len0,(*If saved list exists, load it*)
temp$shape=Join[save$shape,Table[{"Cuboid",Table[0.2,{5}]},{len0-len}]],
temp$shape=save$shape[[1;;len0]]],(*If not, create new one*)
temp$shape=Table[{"Cuboid",Table[0.2,{5}]},{len0}]];
(*---Logic List for Opener---*)
temp$shapeopn=Table[False,{len0}];
(*---Input Field Module---*)
TableForm[Table[{
(*Copy & Past*)
With[{n=n},Button[Style["Copy",Small],
temp$shapecopy=temp$shape[[n]],ImageSize->Small]],
With[{n=n},Button[Style["Paste",Small],
If[ValueQ[temp$shapecopy],temp$shape[[n]]=temp$shapecopy],ImageSize->Small]],
(*Select Menu*)
PopupMenu[With[{n=n},Dynamic[temp$shape[[n,1]]]],list$BodyShape],
(*Dimension*)
TableForm[
{Table[With[{n=n,m=m},
Dynamic[Style[list$ShapeDimNote[temp$shape[[n,1]]][[m]],Small]]],{m,5}],
Table[InputField[With[{n=n,m=m},
Dynamic[temp$shape[[n,2,m]]]],Number,FieldSize->{3.,1.}],{m,5}]}],
(*Opener*)
Opener[With[{n=n},Dynamic[temp$shapeopn[[n]]]]],
(*Show Image*)
PaneSelector[
{False->"Show Image",
True->With[{n=n},Dynamic[Show[Graphics3D[
mod$Create3DShapeEx[temp$shape[[n,1]],temp$shape[[n,2]]],
{ViewPoint->{10,10,50},ViewVertical->{0,1,0}}],ImageSize->100]]]},
With[{n=n},Dynamic[temp$shapeopn[[n]]]],ImageSize->Automatic]},
{n,len0}],TableHeadings->{Table[save$bdn[[n,2]],{n,len0}],
{"Copy","Paste","Select Shape","Dimension","","Appearance"}}]],
(*---Save & Cancel Button---*)
TableForm[{{Button[Style["Save",Bold],
DialogReturn[save$shape=temp$shape]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},(*Cancel Button*)
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,500},WindowTitle->"1-3 Set Body Shapes"];
];

1-4 Set Initial Position

set position

mod$SetInitPos:=
(*---Check Previous Setting---*)
If[Not[ValueQ[save$bdn]],(*If body names have not been set yet, return error*)
Beep[];CreateDialog[{"Set Body Name First.",DefaultButton[]},WindowTitle->"Error"];,
CreateDialog[{
(*---Title---*)
TextCell[Style["Set Initial Position of Rigid Bodies",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,1]],
(*---Load List---*)
Module[{len0=Length[save$bdn],len},
If[ValueQ[save$initpos],len=Length[save$initpos];
If[len<len0,(*If saved list exists, load it*)
temp$initpos=Join[save$initpos,Table[0,{len0-len},{3}]],
temp$initpos=save$initpos[[1;;len0]]],(*If not, create new one*)
temp$initpos=Table[0,{len0},{3}]];
(*---Input Field Module---*)
TableForm[{{
TableForm[
Table[{With[{n=n},Dynamic[save$bdn[[n,2]]]],
InputField[With[{n=n},Dynamic[temp$initpos[[n,1]]/mm,
(temp$initpos[[n,1]]=#*mm)&]],Number,FieldSize->{8.,1.}],
InputField[With[{n=n},Dynamic[temp$initpos[[n,2]]/mm,
(temp$initpos[[n,2]]=#*mm)&]],Number,FieldSize->{8.,1.}],
InputField[With[{n=n},Dynamic[temp$initpos[[n,3]]/mm,
(temp$initpos[[n,3]]=#*mm)&]],Number,FieldSize->{8.,1.}]},{n,len0}],
TableAlignments->Center,
TableHeadings->{None,{"Name","x [mm]","y [mm]","z [mm]"}}],
Dynamic[Graphics3D[Table[mod$Create3DShape[temp$initpos[[n]],save$shape[[n,1]],save$shape[[n,2]]],
{n,Length[temp$initpos]}],ViewPoint->{10,10,50},ViewVertical->{0,1,0},ImageSize->{150,350}]]}}
,TableAlignments->Top]
],
(*---Save & Cancel Button---*)
TableForm[{{
Button[Style["Save",Bold],DialogReturn[(*Save Button*)
save$initpos=temp$initpos]],
Button["Cancel",DialogReturn[]]}}]},(*Cancel Button*)
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->Automatic,WindowTitle->"1-4 Set Initial Position"]
];

1-L Show Body List

Show Body List

mod$ShowBodyList:=
Dynamic[Pane[
TableForm[{
Style["Body:",RGBColor[0.6,0,0],Bold],
If[ValueQ[save$bdn],
TableForm[Table[
{If[save$bdn[[n,1]],"O",""],save$bdn[[n,2]],
If[ValueQ[save$mass],save$mass[[n,1]],save$mass;""],
If[ValueQ[save$mass],save$mass[[n,2,1,1]],save$mass;""],
If[ValueQ[save$mass],save$mass[[n,2,2,2]],save$mass;""],
If[ValueQ[save$mass],save$mass[[n,2,3,3]],save$mass;""],
If[ValueQ[save$shape],save$shape[[n,1]],save$shape;""]
},{n,Min[Length[save$bdn],If[ValueQ[save$mass],Length[save$mass],30],
If[ValueQ[save$shape],Length[save$shape],30]]}],
TableHeadings->{None,Map[(Style[#,RGBColor[0,0,0.6]])&,
{"GND","Name","M [kg]","Ixx [kgm2]","Iyy [kgm2]","Izz [kgm2]","Shape"}]}],
save$bdn;"No Data"]
}],
Scrollbars->True,ImageSize->{640,200},AppearanceElements->None]];

2. Set Connection

2-0 Set Material

Material List

list$Material={
{"Maraging Steel",8.0,195,0.3,1.,-3,"Virgo Data"},
{"C-70 Steel",7.8,200,0.3,3.,-4,"LIGO-G050087-00"},
{"Tungsten",19.3,411,0.28,1.,-4,"Wikipedia"},
{"Copper Beryllium",8.4,134,0.3,5.,-6,"www.alb-copperalloys.com"},
{"Sapphire",3.98,345,0.3,2.,-7,"www.crystalsystems.com"},
{"Bolfur",7.6,157,0.3,1.,-3,"www.alb-copperalloys.com"}
};

** Poisson Ratio of the Maraging Steel Wire **
I adopt an abnormal PoissonR = 0.9 because it fits Virgo' s cables (assembled). The value is abnormal, maybe it 
depend on electrical cabling, but it fits the measurements and the lowest freq change is relevant for yaw.
We can decide to adopt standard 0.3 but expecting such a change once assembled.                    by E. Majorana

Set Material Parameters

mod$SetMaterial:=
CreateDialog[{
(*---Title---*)
TextCell[Style["Set Material Properties",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.6]],
(*---New Material Button---*)
Button[Style["Resistrate New Material",White,Bold],
AppendTo[temp$mat,{"",1.,100,0.3,1,-3,""}],
Appearance->"FramedPalette",Background->Black],
(*---Import List---*)
If[ValueQ[save$mat],temp$mat=save$mat,temp$mat=list$Material];
If[ValueQ[save$wire],temp$wire=save$wire,temp$wire={}];
(*---Main Input Module---*)
Dynamic[
TableForm[Table[{
With[{n=n},Button[Style["Delete",Small],
temp$mat=Delete[temp$mat,{n}],ImageSize->Small]],
With[{n=n},Button[Style["Copy",Small],
AppendTo[temp$mat,temp$mat[[n]]],ImageSize->Small]],
InputField[With[{n=n},Dynamic[temp$mat[[n,1]]]],String,FieldSize->{15.,1.}],
InputField[With[{n=n},Dynamic[temp$mat[[n,2]]]],Number,FieldSize->{5.,1.}],
InputField[With[{n=n},Dynamic[temp$mat[[n,3]]]],Number,FieldSize->{5.,1.}],
InputField[With[{n=n},Dynamic[temp$mat[[n,4]]]],Number,FieldSize->{5.,1.}],
TableForm[{{
InputField[With[{n=n},Dynamic[temp$mat[[n,5]]]],Number,FieldSize->{2.,1.}],"E",
InputField[With[{n=n},Dynamic[temp$mat[[n,6]]]],Number,FieldSize->{2.,1.}]}}],
InputField[With[{n=n},Dynamic[temp$mat[[n,7]]]],String,FieldSize->{30.,1.}]},
{n,Length[temp$mat]}],TableHeadings->{None,
{"Del","Copy","Name","Dens[g/cm3]","E [GPa]","Poisson","Loss","MEMO"}}]
],
(*---Save & Cancel Button---*)
TableForm[{{Button[Style["Save",Bold],
DialogReturn[save$mat=temp$mat]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},(*Cancel Button*)
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{800,500},WindowTitle->"Set Material"];

2-1 Set Wires

Set Wires

mod$SetWires:=
(*---Check Previous Setting---*)
If[Not[ValueQ[save$bdn]&&ValueQ[save$shape]],(*If body names have not been set yet, return error*)
Beep[];CreateDialog[{"Registrate Bodies First.",DefaultButton[]},WindowTitle->"Error"];,

(* ***********************Version 1.2******************************** *)
(*Wire Version 1.2 Compriance Check*)
Do[
If[Length[save$wire2[[n,4]]]==5,AppendTo[save$wire2[[n,4]],0.]];
,{n,Length[save$wire2]}];
(* ***********************Version 1.2******************************** *)

(*---Main Dialog---*)
CreateDialog[{
tabviewwire=1;
(*---Title---*)
TextCell[Style["Set Wires",
Bold,Italic,Black],Background->RGBColor[0.6,1.0,0.6]],
(*---New Wire Button---*)
TableForm[{{Button[Style["Create New Wires",Bold,White],mod$NewWires,
Appearance->"FramedPalette",Background->Black],
Button[Style["Set Material Properties",Bold,Black,Small],mod$SetMaterial,
Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]]
}}],

TabView[{Style["Edit Each Wire",Bold]->
TableForm[{
(*---Load Lists---*)
If[Not[ValueQ[save$mat]],save$mat=list$Material];
If[ValueQ[save$wire],temp$wire=save$wire,temp$wire={}];
(*---Input Field Module---*)
Dynamic[TableForm[Table[{
(*Delete Button*)
With[{n=n},Button[Style["Delete",Small],
temp$wire=Delete[temp$wire,{n}],ImageSize->Small]],
With[{n=n},Button[Style["Copy",Small],
AppendTo[temp$wire,temp$wire[[n]]],ImageSize->Small]],
(*Name*)
InputField[With[{n=n},Dynamic[temp$wire[[n,13]]]],String,FieldSize->{8.,1.}],
(*Upper Body*)
PopupMenu[With[{n=n},Dynamic[temp$wire[[n,1]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
(*Upper SP*)
TableForm[{Table[InputField[With[{n=n,m=m},
Dynamic[temp$wire[[n,2,m]]/mm,(temp$wire[[n,2,m]]=#*mm)&]],
Number,FieldSize->{4.,1.}],{m,3}]}],
(*Lower Body*)
PopupMenu[With[{n=n},Dynamic[temp$wire[[n,3]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
(*Lower SP*)
TableForm[{Table[InputField[With[{n=n,m=m},
Dynamic[temp$wire[[n,4,m]]/mm,(temp$wire[[n,4,m]]=#*mm)&]],
Number,FieldSize->{4.,1.}],{m,3}]}],
(*Material*)
PopupMenu[With[{n=n},Dynamic[temp$wire[[n,5]]]],
Table[m->save$mat[[m,1]],{m,Length[save$mat]}]],
With[{n=n},Dynamic[save$mat[[temp$wire[[n,5]],3]]]],
With[{n=n},Dynamic[save$mat[[temp$wire[[n,5]],4]]]],
TableForm[{{With[{n=n},Dynamic[save$mat[[temp$wire[[n,5]],5]]]],
"E",With[{n=n},Dynamic[save$mat[[temp$wire[[n,5]],6]]]]}}],
(*Length*)
InputField[With[{n=n},Dynamic[temp$wire[[n,6]]]],Number,FieldSize->{5.,1.}],
(*Diameter*)
InputField[With[{n=n},Dynamic[temp$wire[[n,7]]/mm,
(temp$wire[[n,7]]=#*mm)&]],Number,FieldSize->{5.,1.}],
(*Neck L*)
InputField[With[{n=n},Dynamic[temp$wire[[n,8]]/mm,
(temp$wire[[n,8]]=#*mm)&]],Number,FieldSize->{5.,1.}],
(*Neck D*)
InputField[With[{n=n},Dynamic[temp$wire[[n,9]]/mm,
(temp$wire[[n,9]]=#*mm)&]],Number,FieldSize->{5.,1.}],
(*Tension*)
InputField[With[{n=n},Dynamic[temp$wire[[n,10]]]],Number,FieldSize->{5.,1.}],
(*Upper Clamp Vector*)
TableForm[{Table[InputField[With[{n=n,m=m},
Dynamic[temp$wire[[n,11,m]]]],Number,FieldSize->{4.,1.}],{m,3}]}],
(*Lower Clamp Vector*)
TableForm[{Table[InputField[With[{n=n,m=m},
Dynamic[temp$wire[[n,12,m]]]],Number,FieldSize->{4.,1.}],{m,3}]}],
(*Longitudinal Stiffness*)
InputField[With[{n=n},Dynamic[temp$wire[[n,14]]]],Number,FieldSize->{7.,1.}],
(*Torsional Stiffness*)
InputField[With[{n=n},Dynamic[temp$wire[[n,15]]]],Number,FieldSize->{7.,1.}]
},{n,Length[temp$wire]}],TableHeadings->{None,
{"Del","Copy","Name","U Body","U Clamp Pos [mm]","L Body","L Clamp Pos [mm]","Mat",
"E [GPa]","Poission R","Loss [rad]","L [m]","D [mm]","NL [mm]","ND [mm]","T [N]",
"Upper Clamp Direction","Lower Clamp Direction","ks [N/m]","kt [Nm/rad]"}}]],
(*---Save & Cancel Button---*)
TableForm[{{
Button[Style["Save",Bold],DialogReturn[(save$wire=temp$wire;save$wire2=temp$wire2;)]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]
}],

(*WIRE LIST 2*)
Style["Edit Wire Connection",Bold]->
TableForm[{
(*---Load Lists---*)
If[ValueQ[save$wire2],temp$wire2=save$wire2,temp$wire2={}];

Dynamic[TableForm[Table[{
(*Delete Button*)
With[{n=n},Button[Style["Delete",Small],
temp$wire2=Delete[temp$wire2,{n}],ImageSize->Small]],
With[{n=n},Button[Style["Copy",Small],
AppendTo[temp$wire2,temp$wire2[[n]]],ImageSize->Small]],
With[{n=n},Button[Style["Edit",Small],mod$EditWires[n],ImageSize->Small]],

(*Wire Number*)
PopupMenu[With[{n=n},Dynamic[temp$wire2[[n,1]]]],{1,2,3,4}],
(*Upper Body*)
PopupMenu[With[{n=n},Dynamic[temp$wire2[[n,2]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
(*Lower Body*)
PopupMenu[With[{n=n},Dynamic[temp$wire2[[n,3]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
(*Suspension Point Parameters*)
TableForm[{Table[InputField[With[{n=n,m=m},
Dynamic[temp$wire2[[n,4,m]]/{mm,mm,mm,mm,deg,mm}[[m]],
(temp$wire2[[n,4,m]]=#*{mm,mm,mm,mm,deg,mm}[[m]])&]],
Number,FieldSize->{4.,1.}],{m,6}]}],
(*Material*)
PopupMenu[With[{n=n},Dynamic[temp$wire2[[n,5]]]],
Table[m->save$mat[[m,1]],{m,Length[save$mat]}]],
(*Length*)
InputField[With[{n=n},Dynamic[temp$wire2[[n,6,1]]]],Number,FieldSize->{5.,1.}],
(*Diameter*)
InputField[With[{n=n},Dynamic[temp$wire2[[n,6,2]]/mm,
(temp$wire2[[n,6,2]]=#*mm)&]],Number,FieldSize->{5.,1.}],
(*Tension*)
InputField[With[{n=n},Dynamic[temp$wire2[[n,7]]]],Number,FieldSize->{5.,1.}]
},{n,Length[temp$wire2]}],TableHeadings->{None,
{"Del","Copy","Edit","Num","U Body","L Body","Clamp Position Parameters [mm]","Material",
"L [m]","D [mm]","T [N]"}}]],

TableForm[{{
Button[Style["Reflect Changes to Wire List",Bold],(mod$ReflectWires;tabviewwire=1;)]}}]

}]

},Dynamic[tabviewwire]]

},


(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},WindowSize->{800,500},WindowTitle->"2-1 Set Wires"](*Cancel Button*)
];

Edit wire

mod$EditWires[nw_]:=
CreateDialog[{
(*---Title---*)
TextCell[Style["Registrate New Wires",
Bold,Italic,White],Background->Black],
(*---Import Material List---*)
If[Not[ValueQ[save$mat]],save$mat=list$Material];
(*---New wire temporary list---*)
temp$newwire=temp$wire2[[nw]];
(*---Number of Wires---*)
TextCell[Style["How many wires for suspension?",
Bold,Italic,Black],Background->RGBColor[1,0.6,0.6]],
PopupMenu[Dynamic[temp$newwire[[1]]],{1,2,3,4}],
(*---Attached Bodies---*)
TextCell[Style["Set attaching bodies",
Bold,Italic,Black],Background->RGBColor[0.6,0.8,0.6]],
TableForm[{{"Upper body:",PopupMenu[Dynamic[temp$newwire[[2]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
"Lower body:",PopupMenu[Dynamic[temp$newwire[[3]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]]}}],
(*---Clamp Position---*)
TextCell[Style["Set clamp position",
Bold,Italic,Black],Background->RGBColor[0.6,1,0.6]],
TableForm[{{(*Version 1.2*)
TableForm[Table[{With[{n=n},Dynamic[mod$SPNoteList[temp$newwire[[1]]][[n]]]],
InputField[With[{n=n},Dynamic[temp$newwire[[4,n]]/{mm,mm,mm,mm,deg,mm}[[n]],
(temp$newwire[[4,n]]=#*{mm,mm,mm,mm,deg,mm}[[n]])&]],Number,FieldSize->{4.,1.},
Enabled->With[{n=n},Dynamic[Not[mod$SPNoteList[temp$newwire[[1]]][[n]]==""]]]]},
{n,6}]],
(*3D Graphics*)
Dynamic[Show[Graphics3D[mod$DrawWires,
{ViewPoint->{10,10,50},ViewVertical->{0,1,0}}],ImageSize->100]],
Dynamic[Show[Graphics3D[mod$DrawWires,
{ViewPoint->{0,Infinity,0},ViewVertical->{0,0,-1}}],ImageSize->100]]
}}],
(*---Select Material---*)
TextCell[Style["Select Material",
Bold,Italic,Black],Background->RGBColor[0.6,0.8,0.8]],
Button[Style["Set Material Properties",Bold,Black,Small],mod$SetMaterial,
Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
Dynamic[TableForm[{{
PopupMenu[Dynamic[temp$newwire[[5]]],
Table[n->save$mat[[n,1]],{n,Length[save$mat]}]],
Dynamic[save$mat[[temp$newwire[[5]],3]]],Dynamic[save$mat[[temp$newwire[[5]],4]]],
TableForm[{{Dynamic[save$mat[[temp$newwire[[5]],5]]],"E",
Dynamic[save$mat[[temp$newwire[[5]],6]]]}}]}},
TableHeadings->{None,{"Material","Young [GPa]","Poisson","Loss [rad]"}}]],
(*---Dimension---*)
TextCell[Style["Wire Dimension",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,1]],
TableForm[{{Checkbox[Dynamic[temp$newwire[[6,5]]]],"Variable Thickness",
Checkbox[Dynamic[temp$newwire[[6,6]]]],"Wire Length with Tension"}}],
TableForm[{{
InputField[Dynamic[temp$newwire[[6,1]]/meter,
(temp$newwire[[6,1]]=#*meter)&],Number,FieldSize->{5.,1.}],
InputField[Dynamic[temp$newwire[[6,2]]/mm,(temp$newwire[[6,2]]=#*mm)&],Number,FieldSize->{5.,1.}],
InputField[Dynamic[temp$newwire[[6,3]]/mm,(temp$newwire[[6,3]]=#*mm)&],Number,FieldSize->{5.,1.},
Enabled->Dynamic[temp$newwire[[6,5]]]],
InputField[Dynamic[temp$newwire[[6,4]]/mm,(temp$newwire[[6,4]]=#*mm)&],Number,FieldSize->{5.,1.},
Enabled->Dynamic[temp$newwire[[6,5]]]]
}},TableHeadings->{None,{"Length [m]","Diam [mm]","Neck L[mm]","Neck D[mm]"}}],
(*---Stiffness--*)
TextCell[Style["Stiffness",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,1]],
Button[Style["Calculate from Wire Dimension",Bold,Black,Small],mod$CalcWireStiff,
Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{{"Longitudinal Stiffness:",
InputField[Dynamic[temp$newwire[[8,1]]],Number,FieldSize->{7.,1.}],"N/m"},
{"Torsional Stiffness:",
InputField[Dynamic[temp$newwire[[8,2]]],Number,FieldSize->{7.,1.}],"Nm/rad"
}}],
(*---Tension---*)
TextCell[Style["Tension on Each Wire",
Bold,Italic,Black],Background->RGBColor[0.8,0.6,0.8]],
Button[Style["Calculate From Suspended Mass",Bold,Black,Small],mod$CalcWireTension,
Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{{InputField[Dynamic[temp$newwire[[7]]],FieldSize->{5.,1.}],"N",
"(",InputField[Dynamic[temp$newwire[[7]]/g,(temp$newwire[[7]]=#*g)&],FieldSize->{5.,1.}],"kgw)"}}],
(*---Create Wire---*)
TextCell[Style["Finish",
Bold,Italic,White],Background->RGBColor[0,0,0]],
TableForm[{{Button[Style["Finish",Bold],DialogReturn[temp$wire2[[nw]]=temp$newwire]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{800,500},WindowTitle->"New Wire Registration"];

New wire

mod$NewWires:=
CreateDialog[{
(*---Title---*)
TextCell[Style["Registrate New Wires",
Bold,Italic,White],Background->Black],
(*---Import Material List---*)
If[Not[ValueQ[save$mat]],save$mat=list$Material];
(*---New wire temporary list---*)
temp$newwire={1,1,2,{-5.mm,5.mm,200.mm,50.mm,0.,0.mm},1,{1.meter,1.mm,20.mm,1.mm,False,True},0.,{0.,0.}};
(*---Number of Wires---*)
TextCell[Style["How many wires for suspension?",
Bold,Italic,Black],Background->RGBColor[1,0.6,0.6]],
PopupMenu[Dynamic[temp$newwire[[1]]],{1,2,3,4}],
(*---Attached Bodies---*)
TextCell[Style["Set attaching bodies",
Bold,Italic,Black],Background->RGBColor[0.6,0.8,0.6]],
TableForm[{{"Upper body:",PopupMenu[Dynamic[temp$newwire[[2]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
"Lower body:",PopupMenu[Dynamic[temp$newwire[[3]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]]}}],
(*---Clamp Position---*)
TextCell[Style["Set clamp position",
Bold,Italic,Black],Background->RGBColor[0.6,1,0.6]],
TableForm[{{(*Version 1.2*)
TableForm[Table[{With[{n=n},Dynamic[mod$SPNoteList[temp$newwire[[1]]][[n]]]],
InputField[With[{n=n},Dynamic[temp$newwire[[4,n]]/{mm,mm,mm,mm,deg,mm}[[n]],
(temp$newwire[[4,n]]=#*{mm,mm,mm,mm,deg,mm}[[n]])&]],Number,FieldSize->{4.,1.},
Enabled->With[{n=n},Dynamic[Not[mod$SPNoteList[temp$newwire[[1]]][[n]]==""]]]]},
{n,6}]],
(*3D Graphics*)
Dynamic[Show[Graphics3D[mod$DrawWires,
{ViewPoint->{10,10,50},ViewVertical->{0,1,0}}],ImageSize->100]],
Dynamic[Show[Graphics3D[mod$DrawWires,
{ViewPoint->{0,Infinity,0},ViewVertical->{0,0,-1}}],ImageSize->100]]
}}],
(*---Select Material---*)
TextCell[Style["Select Material",
Bold,Italic,Black],Background->RGBColor[0.6,0.8,0.8]],
Button[Style["Set Material Properties",Bold,Black,Small],mod$SetMaterial,
Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
Dynamic[TableForm[{{
PopupMenu[Dynamic[temp$newwire[[5]]],
Table[n->save$mat[[n,1]],{n,Length[save$mat]}]],
Dynamic[save$mat[[temp$newwire[[5]],3]]],Dynamic[save$mat[[temp$newwire[[5]],4]]],
TableForm[{{Dynamic[save$mat[[temp$newwire[[5]],5]]],"E",
Dynamic[save$mat[[temp$newwire[[5]],6]]]}}]}},
TableHeadings->{None,{"Material","Young [GPa]","Poisson","Loss [rad]"}}]],
(*---Dimension---*)
TextCell[Style["Wire Dimension",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,1]],
TableForm[{{Checkbox[Dynamic[temp$newwire[[6,5]]]],"Variable Thickness",
Checkbox[Dynamic[temp$newwire[[6,6]]]],"Wire Length with Tension"}}],
TableForm[{{
InputField[Dynamic[temp$newwire[[6,1]]/meter,
(temp$newwire[[6,1]]=#*meter)&],Number,FieldSize->{5.,1.}],
InputField[Dynamic[temp$newwire[[6,2]]/mm,(temp$newwire[[6,2]]=#*mm)&],Number,FieldSize->{5.,1.}],
InputField[Dynamic[temp$newwire[[6,3]]/mm,(temp$newwire[[6,3]]=#*mm)&],Number,FieldSize->{5.,1.},
Enabled->Dynamic[temp$newwire[[6,5]]]],
InputField[Dynamic[temp$newwire[[6,4]]/mm,(temp$newwire[[6,4]]=#*mm)&],Number,FieldSize->{5.,1.},
Enabled->Dynamic[temp$newwire[[6,5]]]]
}},TableHeadings->{None,{"Length [m]","Diam [mm]","Neck L[mm]","Neck D[mm]"}}],
(*---Stiffness--*)
TextCell[Style["Stiffness",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,1]],
Button[Style["Calculate from Wire Dimension",Bold,Black,Small],mod$CalcWireStiff,
Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{{"Longitudinal Stiffness:",
InputField[Dynamic[temp$newwire[[8,1]]],Number,FieldSize->{7.,1.}],"N/m"},
{"Torsional Stiffness:",
InputField[Dynamic[temp$newwire[[8,2]]],Number,FieldSize->{7.,1.}],"Nm/rad"
}}],
(*---Tension---*)
TextCell[Style["Tension on Each Wire",
Bold,Italic,Black],Background->RGBColor[0.8,0.6,0.8]],
Button[Style["Calculate From Suspended Mass",Bold,Black,Small],mod$CalcWireTension,
Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{{InputField[Dynamic[temp$newwire[[7]]],FieldSize->{5.,1.}],"N",
"(",InputField[Dynamic[temp$newwire[[7]]/g,(temp$newwire[[7]]=#*g)&],FieldSize->{5.,1.}],"kgw)"}}],
(*---Create Wire---*)
TextCell[Style["Finish",
Bold,Italic,White],Background->RGBColor[0,0,0]],
TableForm[{{Button[Style["Create",Bold],DialogReturn[mod$CreateWires]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{800,500},WindowTitle->"New Wire Registration"];

Calculate Wire Stiffness

mod$CalcWireStiff:=(
temp$newwire[[8,1]]=save$mat[[temp$newwire[[5]],3]]GPa/
If[temp$newwire[[6,5]],((temp$newwire[[6,1]]-2*temp$newwire[[6,3]])/(N[Pi]*temp$newwire[[6,2]]^2/4)+
2*temp$newwire[[6,3]]/(N[Pi]*temp$newwire[[6,4]]^2/4)),
(temp$newwire[[6,1]]/(N[Pi]*temp$newwire[[6,2]]^2/4))];
temp$newwire[[8,2]]=save$mat[[temp$newwire[[5]],3]]GPa/2/(1+save$mat[[temp$newwire[[5]],4]])/
If[temp$newwire[[6,5]],((temp$newwire[[6,1]]-2*temp$newwire[[6,3]])/(N[Pi]*temp$newwire[[6,2]]^4/32)+
2*temp$newwire[[6,3]]/(N[Pi]*temp$newwire[[6,4]]^4/32)),
(temp$newwire[[6,1]]/(N[Pi]*temp$newwire[[6,2]]^4/32))];
);

Suspension Point Note List

mod$SPNoteList[num_]:=Which[
num==1,
{"Vertical position of upper SP wrt upper body's CoM [mm]",
"Vertical position of lower SP wrt lower body's CoM [mm]",
"","","",""},
num==2,
{"Vertical position of upper SP wrt upper body's CoM [mm]",
"Vertical position of lower SP wrt lower body's CoM [mm]",
"X-distance between upper SP & upper body's COM [mm]",
"X-distance between lower SP & lower body's COM [mm]","",""},
num==3,
{"Vertical position of upper SP wrt upper body's CoM [mm]",
"Vertical position of lower SP wrt lower body's CoM [mm]",
"Horizontal radial distance from body's COM [mm]","",
"Rotation angle in the horizontal plane [deg]",""},
num==4,
{"Vertical position of upper SP wrt upper body's CoM [mm]",
"Vertical position of lower SP wrt lower body's CoM [mm]",
"X-distance from body's COM [mm]",
"Z-distance from body's COM [mm]","",
"Upper SP Z-translation from COM [mm]"}
];

Wire Tension

mod$CalcWireTension:=CreateDialog[{
(*---Title---*)
TextCell[Style["Check the masses suspended below the wires:",
Bold,Black,Italic],Background->RGBColor[.6,.6,.6]],
(*---Logic List---*)
temp$wten=Table[False,{Length[save$bdn]}];
(*---Check List for Calculation---*)
TableForm[Partition[
Table[{{Checkbox[With[{n=n},Dynamic[temp$wten[[n]]]]],save$bdn[[n,2]]}},
{n,Length[save$bdn]}],6,6,1,{}]],
(*---Calculator---*)
TableForm[{{"Total Mass:",Dynamic[Sum[If[temp$wten[[n]],save$mass[[n,1]],0],
{n,Length[save$bdn]}]],"kg"}}],
(*---OK & Cancel Button---*)
TableForm[{{
Button["OK",DialogReturn[temp$newwire[[7]]=
N[Sum[If[temp$wten[[n]],save$mass[[n,1]],0],
{n,Length[save$bdn]}]]*g/temp$newwire[[1]]/If[temp$newwire[[1]]==2,
Cos[(temp$newwire[[4,3]]-temp$newwire[[4,4]])/temp$newwire[[6,1]]],1]]],
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{400,200},WindowTitle->"Set Material"];

Create Wire

mod$CreateWires:=Module[{},Which[
temp$newwire[[1]]==1,
Do[AppendTo[temp$wire,
{temp$newwire[[2]],mod$SP1wire[temp$newwire[[4,1]]][[n]],
temp$newwire[[3]],mod$SP1wire[temp$newwire[[4,2]]][[n]],
temp$newwire[[5]],
If[temp$newwire[[6,6]],temp$newwire[[6,1]]-temp$newwire[[7]]/temp$newwire[[8,1]],temp$newwire[[6,1]]],
temp$newwire[[6,2]],
If[temp$newwire[[6,5]],temp$newwire[[6,3]],0],
If[temp$newwire[[6,5]],temp$newwire[[6,4]],temp$newwire[[6,2]]],
temp$newwire[[7]],{0,-1,0},{0,1,0},save$bdn[[temp$newwire[[2]],2]]<>"-"<>
save$bdn[[temp$newwire[[3]],2]]<>"-"<>ToString[n],
temp$newwire[[8,1]],temp$newwire[[8,2]]}
];,{n,1}],
temp$newwire[[1]]==2,
Do[AppendTo[temp$wire,
{temp$newwire[[2]],mod$SP2wire[temp$newwire[[4,1]],temp$newwire[[4,3]]][[n]],
temp$newwire[[3]],mod$SP2wire[temp$newwire[[4,2]],temp$newwire[[4,4]]][[n]],
temp$newwire[[5]],
If[temp$newwire[[6,6]],temp$newwire[[6,1]]-temp$newwire[[7]]/temp$newwire[[8,1]],temp$newwire[[6,1]]],
temp$newwire[[6,2]],
If[temp$newwire[[6,5]],temp$newwire[[6,3]],0],
If[temp$newwire[[6,5]],temp$newwire[[6,4]],temp$newwire[[6,2]]],temp$newwire[[7]],
normalize[{If[n==1,-1,+1]*(temp$newwire[[4,3]]-temp$newwire[[4,4]]),
-Sqrt[temp$newwire[[6,1]]^2-(temp$newwire[[4,3]]-temp$newwire[[4,4]])^2],0}],
normalize[{If[n==1,+1,-1]*(temp$newwire[[4,3]]-temp$newwire[[4,4]]),
Sqrt[temp$newwire[[6,1]]^2-(temp$newwire[[4,3]]-temp$newwire[[4,4]])^2],0}],
save$bdn[[temp$newwire[[2]],2]]<>"-"<>
save$bdn[[temp$newwire[[3]],2]]<>"-"<>ToString[n],
temp$newwire[[8,1]],temp$newwire[[8,2]]}];,{n,2}],
temp$newwire[[1]]==3,
Do[AppendTo[temp$wire,
{temp$newwire[[2]],mod$SP3wire[temp$newwire[[4,1]],temp$newwire[[4,3]],temp$newwire[[4,5]]][[n]],
temp$newwire[[3]],mod$SP3wire[temp$newwire[[4,2]],temp$newwire[[4,3]],temp$newwire[[4,5]]][[n]],
temp$newwire[[5]],
If[temp$newwire[[6,6]],temp$newwire[[6,1]]-temp$newwire[[7]]/temp$newwire[[8,1]],temp$newwire[[6,1]]],
temp$newwire[[6,2]],
If[temp$newwire[[6,5]],temp$newwire[[6,3]],0],
If[temp$newwire[[6,5]],temp$newwire[[6,4]],temp$newwire[[6,2]]],
temp$newwire[[7]],{0,-1,0},{0,1,0},
save$bdn[[temp$newwire[[2]],2]]<>"-"<>
save$bdn[[temp$newwire[[3]],2]]<>"-"<>ToString[n],
temp$newwire[[8,1]],temp$newwire[[8,2]]}];,{n,3}],
temp$newwire[[1]]==4,
Do[AppendTo[temp$wire,
{temp$newwire[[2]],mod$SP4wire[temp$newwire[[4,3]],temp$newwire[[4,1]],temp$newwire[[4,4]]][[n]]
(*Version 1.2*)+{0,0,temp$newwire[[4,6]]},
temp$newwire[[3]],mod$SP4wire[temp$newwire[[4,3]],temp$newwire[[4,2]],temp$newwire[[4,4]]][[n]],
temp$newwire[[5]],
If[temp$newwire[[6,6]],temp$newwire[[6,1]]-temp$newwire[[7]]/temp$newwire[[8,1]],temp$newwire[[6,1]]],
temp$newwire[[6,2]],
If[temp$newwire[[6,5]],temp$newwire[[6,3]],0],
If[temp$newwire[[6,5]],temp$newwire[[6,4]],temp$newwire[[6,2]]],
temp$newwire[[7]],{0,-1,0},{0,1,0},
save$bdn[[temp$newwire[[2]],2]]<>"-"<>
save$bdn[[temp$newwire[[3]],2]]<>"-"<>ToString[n],
temp$newwire[[8,1]],temp$newwire[[8,2]]}];,{n,4}]
];
AppendTo[temp$wire2,temp$newwire];
];

Reflect Changes to Wire List

mod$ReflectWires:=Module[{temp$newwire},
temp$wire={};
Do[
temp$newwire=temp$wire2[[n]];
Which[
temp$newwire[[1]]==1,
Do[AppendTo[temp$wire,
{temp$newwire[[2]],mod$SP1wire[temp$newwire[[4,1]]][[n]],
temp$newwire[[3]],mod$SP1wire[temp$newwire[[4,2]]][[n]],
temp$newwire[[5]],
If[temp$newwire[[6,6]],temp$newwire[[6,1]]-temp$newwire[[7]]/temp$newwire[[8,1]],temp$newwire[[6,1]]],
temp$newwire[[6,2]],
If[temp$newwire[[6,5]],temp$newwire[[6,3]],0],
If[temp$newwire[[6,5]],temp$newwire[[6,4]],temp$newwire[[6,2]]],
temp$newwire[[7]],{0,-1,0},{0,1,0},save$bdn[[temp$newwire[[2]],2]]<>"-"<>
save$bdn[[temp$newwire[[3]],2]]<>"-"<>ToString[n],
temp$newwire[[8,1]],temp$newwire[[8,2]]}
];,{n,1}],
temp$newwire[[1]]==2,
Do[AppendTo[temp$wire,
{temp$newwire[[2]],mod$SP2wire[temp$newwire[[4,1]],temp$newwire[[4,3]]][[n]],
temp$newwire[[3]],mod$SP2wire[temp$newwire[[4,2]],temp$newwire[[4,4]]][[n]],
temp$newwire[[5]],
If[temp$newwire[[6,6]],temp$newwire[[6,1]]-temp$newwire[[7]]/temp$newwire[[8,1]],temp$newwire[[6,1]]],
temp$newwire[[6,2]],
If[temp$newwire[[6,5]],temp$newwire[[6,3]],0],
If[temp$newwire[[6,5]],temp$newwire[[6,4]],temp$newwire[[6,2]]],temp$newwire[[7]],
normalize[{If[n==1,-1,+1]*(temp$newwire[[4,3]]-temp$newwire[[4,4]]),
-Sqrt[temp$newwire[[6,1]]^2-(temp$newwire[[4,3]]-temp$newwire[[4,4]])^2],0}],
normalize[{If[n==1,+1,-1]*(temp$newwire[[4,3]]-temp$newwire[[4,4]]),
Sqrt[temp$newwire[[6,1]]^2-(temp$newwire[[4,3]]-temp$newwire[[4,4]])^2],0}],
save$bdn[[temp$newwire[[2]],2]]<>"-"<>
save$bdn[[temp$newwire[[3]],2]]<>"-"<>ToString[n],
temp$newwire[[8,1]],temp$newwire[[8,2]]}];,{n,2}],
temp$newwire[[1]]==3,
Do[AppendTo[temp$wire,
{temp$newwire[[2]],mod$SP3wire[temp$newwire[[4,1]],temp$newwire[[4,3]],temp$newwire[[4,5]]][[n]],
temp$newwire[[3]],mod$SP3wire[temp$newwire[[4,2]],temp$newwire[[4,3]],temp$newwire[[4,5]]][[n]],
temp$newwire[[5]],
If[temp$newwire[[6,6]],temp$newwire[[6,1]]-temp$newwire[[7]]/temp$newwire[[8,1]],temp$newwire[[6,1]]],
temp$newwire[[6,2]],
If[temp$newwire[[6,5]],temp$newwire[[6,3]],0],
If[temp$newwire[[6,5]],temp$newwire[[6,4]],temp$newwire[[6,2]]],
temp$newwire[[7]],{0,-1,0},{0,1,0},
save$bdn[[temp$newwire[[2]],2]]<>"-"<>
save$bdn[[temp$newwire[[3]],2]]<>"-"<>ToString[n],
temp$newwire[[8,1]],temp$newwire[[8,2]]}];,{n,3}],
temp$newwire[[1]]==4,
Do[AppendTo[temp$wire,
{temp$newwire[[2]],mod$SP4wire[temp$newwire[[4,3]],temp$newwire[[4,1]],temp$newwire[[4,4]]][[n]]
(*Version 1.2*)+{0,0,temp$newwire[[4,6]]},
temp$newwire[[3]],mod$SP4wire[temp$newwire[[4,3]],temp$newwire[[4,2]],temp$newwire[[4,4]]][[n]],
temp$newwire[[5]],
If[temp$newwire[[6,6]],temp$newwire[[6,1]]-temp$newwire[[7]]/temp$newwire[[8,1]],temp$newwire[[6,1]]],
temp$newwire[[6,2]],
If[temp$newwire[[6,5]],temp$newwire[[6,3]],0],
If[temp$newwire[[6,5]],temp$newwire[[6,4]],temp$newwire[[6,2]]],
temp$newwire[[7]],{0,-1,0},{0,1,0},
save$bdn[[temp$newwire[[2]],2]]<>"-"<>
save$bdn[[temp$newwire[[3]],2]]<>"-"<>ToString[n],
temp$newwire[[8,1]],temp$newwire[[8,2]]}];,{n,4}]
];
,{n,Length[temp$wire2]}];
];

Create 3D shapes Wires

mod$DrawWires:=
Module[{ru={0,0,-temp$newwire[[4,6]]},rl={0,-temp$newwire[[6,1]],0}},
Join[
(*---Wire Drawing---*)
Which[
temp$newwire[[1]]==1,
Table[Line[{mod$SP1wire[temp$newwire[[4,1]]][[n]],
mod$SP1wire[temp$newwire[[4,2]]][[n]]+rl}],{n,1}],
temp$newwire[[1]]==2,
Table[Line[{mod$SP2wire[temp$newwire[[4,1]],temp$newwire[[4,3]]][[n]],
mod$SP2wire[temp$newwire[[4,2]],temp$newwire[[4,4]]][[n]]+rl}],{n,2}],
temp$newwire[[1]]==3,
Table[Line[{mod$SP3wire[temp$newwire[[4,1]],temp$newwire[[4,3]],temp$newwire[[4,5]]][[n]],
mod$SP3wire[temp$newwire[[4,2]],temp$newwire[[4,3]],temp$newwire[[4,5]]][[n]]+rl}],{n,3}],
temp$newwire[[1]]==4,
Table[Line[{mod$SP4wire[temp$newwire[[4,3]],temp$newwire[[4,1]],temp$newwire[[4,4]]][[n]],
mod$SP4wire[temp$newwire[[4,3]],temp$newwire[[4,2]],temp$newwire[[4,4]]][[n]]+rl}],{n,4}]
],
(*---Suspenpension Point Drawing---*)
Which[
temp$newwire[[1]]==1,
Flatten[Table[{Point[mod$SP1wire[temp$newwire[[4,1]]][[n]]],
Point[mod$SP1wire[temp$newwire[[4,2]]][[n]]+rl]},{n,1}],1],
temp$newwire[[1]]==2,
Flatten[Table[{Point[mod$SP2wire[temp$newwire[[4,1]],temp$newwire[[4,3]]][[n]]],
Point[mod$SP2wire[temp$newwire[[4,2]],temp$newwire[[4,4]]][[n]]+rl]},{n,2}],1],
temp$newwire[[1]]==3,
Flatten[Table[{Point[mod$SP3wire[temp$newwire[[4,1]],temp$newwire[[4,3]],temp$newwire[[4,5]]][[n]]],
Point[mod$SP3wire[temp$newwire[[4,2]],temp$newwire[[4,3]],temp$newwire[[4,5]]][[n]]+rl]},{n,3}],1],
temp$newwire[[1]]==4,
Flatten[Table[{Point[mod$SP4wire[temp$newwire[[4,3]],temp$newwire[[4,1]],temp$newwire[[4,4]]][[n]]],
Point[mod$SP4wire[temp$newwire[[4,3]],temp$newwire[[4,2]],temp$newwire[[4,4]]][[n]]+rl]},{n,4}],1]
],
{(*Point[{+1.0,+1.0,+1.0}],
Point[{-1.0,+1.0,+1.0}],
Point[{+1.0,+1.0,-1.0}],
Point[{-1.0,+1.0,-1.0}],
Point[{+1.0,-1.0,+1.0}],
Point[{-1.0,-1.0,+1.0}],
Point[{+1.0,-1.0,-1.0}],
Point[{-1.0,-1.0,-1.0}],*)
Point[ru],Point[rl]
},
{Opacity[0.5]},
{mod$Create3DShape[ru,save$shape[[temp$newwire[[2]],1]],save$shape[[temp$newwire[[2]],2]]],
mod$Create3DShape[rl,save$shape[[temp$newwire[[3]],1]],save$shape[[temp$newwire[[3]],2]]]}
]
];

Wire Suspension Point Generator

mod$SP1wire[dy_]:={{0,dy,0}};

mod$SP2wire[dy_,dx_]:={{+dx,dy,0},{-dx,dy,0}};

mod$SP3wire[dy_,dr_,th_]:=
{{+dr Cos[th+0*N[Pi]/3],dy,-dr Sin[th+0*N[Pi]/3]},
{+dr Cos[th+2*N[Pi]/3],dy,-dr Sin[th+2*N[Pi]/3]},
{+dr Cos[th+4*N[Pi]/3],dy,-dr Sin[th+4*N[Pi]/3]}};

mod$SP4wire[dx_,dy_,dz_]:=
{{-dx,dy,-dz},{-dx,dy,+dz},{+dx,dy,+dz},{+dx,dy,-dz}};

2-2 Set Vertical Springs

Set Vertical Springs

mod$SetVertSprings:=
(*---Check Previous Setting---*)
If[Not[ValueQ[save$wire]],(*If wires have not been set yet, return error*)
Beep[];CreateDialog[{"Set wires first.",DefaultButton[]},WindowTitle->"Error"];,
(*---Main Dialog---*)
CreateDialog[{
(*---Title---*)
TextCell[Style["Set Vertical Springs",
Bold,Italic,Black],Background->RGBColor[0.6,0.9,0.6]],
(*---New Wire Button---*)
Button[Style["Create New Springs",Bold,White],mod$NewVertSprings,
Appearance->"FramedPalette",Background->Black],
(*---Load Lists---*)
If[ValueQ[save$vspr],temp$vspr=save$vspr,temp$vspr={}];
(*---Input Field Module---*)
Dynamic[TableForm[Table[{
With[{n=n},Button[Style["Delete",Small],
temp$vspr=Delete[temp$vspr,{n}],ImageSize->Small]],
With[{n=n},Button[Style["Copy",Small],
AppendTo[temp$vspr,temp$vspr[[n]]],ImageSize->Small]],
With[{n=n},Button[Style["Edit",Small],mod$EditVertSprings[n],ImageSize->Small]],
InputField[With[{n=n},Dynamic[temp$vspr[[n,8]]]],String,FieldSize->{8.,1.}],
TableForm[{{PopupMenu[With[{n=n},Dynamic[temp$vspr[[n,1]]]],
Table[m->save$wire[[m,13]],{m,Length[save$wire]}]],
PopupMenu[With[{n=n},Dynamic[temp$vspr[[n,2]]]],{1->"Upper SP",2->"Lower SP"}]}}],
InputField[With[{n=n},Dynamic[temp$vspr[[n,3]]]],Number,FieldSize->{5.,1.}],
InputField[With[{n=n},Dynamic[temp$vspr[[n,4]]]],Number,FieldSize->{5.,1.}],
InputField[With[{n=n},Dynamic[temp$vspr[[n,9]]]],Number,FieldSize->{5.,1.}],
TableForm[{{
Checkbox[With[{n=n},Dynamic[temp$vspr[[n,5]]]]],
InputField[With[{n=n},Dynamic[temp$vspr[[n,6]]]],Number,FieldSize->{5.,1.},
Enabled->With[{n=n},Dynamic[temp$vspr[[n,5]]]]]
}}],
TableForm[{Table[InputField[With[{n=n,m=m},
Dynamic[temp$vspr[[n,7,m]]]],Number,FieldSize->{3.,1.}],{m,3}]}]
},{n,Length[temp$vspr]}],TableHeadings->{None,
{"Del","Copy","Edit","Name","Position","k [N/m]","fp [N]","Q","CoP [dB]","Direction"}}]],
(*---Save & Cancel Button---*)
TableForm[{{
Button[Style["Save",Bold],DialogReturn[save$vspr=temp$vspr]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},WindowSize->{800,500},WindowTitle->"2-2 Set Vertical Springs"](*Cancel Button*)
];

New Springs

mod$NewVertSprings:=
CreateDialog[{
(*---Title---*)
TextCell[Style["Registrate New Vertical Springs",
Bold,Italic,White],Background->Black],
(*---New spring temporary list---*)
temp$newvspr={1,1,0.,0.,True,-60,{0,1,0},"",1000.};
(*---Name---*)
TextCell[Style["Spring Name",
Bold,Italic,Black],Background->RGBColor[1,0.6,0.6]],
InputField[Dynamic[temp$newvspr[[8]]],String,FieldSize->{8.,1.}],
(*---Choose SP---*)
TextCell[Style["Choose wire suspension point where spring is inserted.",
Bold,Italic,Black],Background->RGBColor[0.9,0.6,0.6]],
TableForm[{{PopupMenu[Dynamic[temp$newvspr[[1]]],
Table[m->save$wire[[m,13]],{m,Length[save$wire]}]],
PopupMenu[Dynamic[temp$newvspr[[2]]],{1->"Upper SP",2->"Lower SP"}]}}],
(*---Stiffness & Prestress---*)
TextCell[Style["Stiffness & Prestress",
Bold,Italic,Black],Background->RGBColor[0.8,0.6,0.6]],
Button[Style["Calculate from wire tension & resonant frequency",Bold,Black,Small],
mod$CalcSprStiff,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{{"Stiffness:",InputField[Dynamic[temp$newvspr[[3]]],Number,FieldSize->{5.,1.}],"N/m"},
{"Prestress:",InputField[Dynamic[temp$newvspr[[4]]],Number,FieldSize->{5.,1.}],"N"}}],
(*---Quality Factor---*)
TextCell[Style["Quality Factor",
Bold,Italic,Black],Background->RGBColor[0.75,0.6,0.6]],
TableForm[{{InputField[Dynamic[temp$newvspr[[9]]],Number,FieldSize->{5.,1.}]}}],
(*---Center of Percussion Effect---*)
TextCell[Style["Center of Percussion Effect",
Bold,Italic,Black],Background->RGBColor[0.7,0.6,0.6]],
TableForm[{{Checkbox[Dynamic[temp$newvspr[[5]]]],
InputField[Dynamic[temp$newvspr[[6]]],Number,FieldSize->{5.,1.},
Enabled->Dynamic[temp$newvspr[[5]]]],"dB"}}],
(*---Working Direction---*)
TextCell[Style["Working Direction",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
TableForm[{Table[InputField[With[{m=m},
Dynamic[temp$newvspr[[7,m]]]],Number,FieldSize->{3.,1.}],{m,3}]}],
(*---Create Spring---*)
TextCell[Style["Finish",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.6]],
TableForm[{{Button[Style["Create",Bold],
DialogReturn[AppendTo[temp$vspr,temp$newvspr]]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,500},WindowTitle->"New Vertical Springs"];

Edit Springs

mod$EditVertSprings[nw_]:=
CreateDialog[{
(*---Title---*)
TextCell[Style["Registrate New Vertical Springs",
Bold,Italic,White],Background->Black],
(*---New spring temporary list---*)
temp$newvspr=temp$vspr[[nw]];
(*---Name---*)
TextCell[Style["Spring Name",
Bold,Italic,Black],Background->RGBColor[1,0.6,0.6]],
InputField[Dynamic[temp$newvspr[[8]]],String,FieldSize->{8.,1.}],
(*---Choose SP---*)
TextCell[Style["Choose wire suspension point where spring is inserted.",
Bold,Italic,Black],Background->RGBColor[0.9,0.6,0.6]],
TableForm[{{PopupMenu[Dynamic[temp$newvspr[[1]]],
Table[m->save$wire[[m,13]],{m,Length[save$wire]}]],
PopupMenu[Dynamic[temp$newvspr[[2]]],{1->"Upper SP",2->"Lower SP"}]}}],
(*---Stiffness & Prestress---*)
TextCell[Style["Stiffness & Prestress",
Bold,Italic,Black],Background->RGBColor[0.8,0.6,0.6]],
Button[Style["Calculate from wire tension & resonant frequency",Bold,Black,Small],
mod$CalcSprStiff,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{{"Stiffness:",InputField[Dynamic[temp$newvspr[[3]]],Number,FieldSize->{5.,1.}],"N/m"},
{"Prestress:",InputField[Dynamic[temp$newvspr[[4]]],Number,FieldSize->{5.,1.}],"N"}}],
(*---Quality Factor---*)
TextCell[Style["Quality Factor",
Bold,Italic,Black],Background->RGBColor[0.75,0.6,0.6]],
TableForm[{{InputField[Dynamic[temp$newvspr[[9]]],Number,FieldSize->{5.,1.}]}}],
(*---Center of Percussion Effect---*)
TextCell[Style["Center of Percussion Effect",
Bold,Italic,Black],Background->RGBColor[0.7,0.6,0.6]],
TableForm[{{Checkbox[Dynamic[temp$newvspr[[5]]]],
InputField[Dynamic[temp$newvspr[[6]]],Number,FieldSize->{5.,1.},
Enabled->Dynamic[temp$newvspr[[5]]]],"dB"}}],
(*---Working Direction---*)
TextCell[Style["Working Direction",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
TableForm[{Table[InputField[With[{m=m},
Dynamic[temp$newvspr[[7,m]]]],Number,FieldSize->{3.,1.}],{m,3}]}],
(*---Create Spring---*)
TextCell[Style["Finish",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.6]],
TableForm[{{Button[Style["Create",Bold],
DialogReturn[temp$vspr[[nw]]=temp$newvspr]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,500},WindowTitle->"New Vertical Springs"];

Calculate Stiffness

mod$CalcSprStiff:=CreateDialog[{
(*---Title---*)
TextCell[Style["Input Resonant Frequency:",
Bold,Black,Italic],Background->RGBColor[.6,.6,.6]],
(*---Frequency---*)
temp$vsprfreq=0.;
TableForm[{{InputField[Dynamic[temp$vsprfreq],Number,FieldSize->{5.,1.}],"Hz"}}],
(*---OK & Cancel Button---*)
TableForm[{{
Button["OK",DialogReturn[
temp$newvspr[[3]]=(save$wire[[temp$newvspr[[1]],10]]/g)*(2*N[Pi]*temp$vsprfreq)^2;
temp$newvspr[[4]]=save$wire[[temp$newvspr[[1]],10]];]],
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{400,200},WindowTitle->"Calculate Stiffness and Prestress"];

2-3 Set Inverted Pendulum

Set Inverted Pendulum

mod$SetIP:=
(*---Check Previous Setting---*)
If[Not[ValueQ[save$bdn]],(*If body names have not been set yet, return error*)
Beep[];CreateDialog[{"Registrate bodies first.",DefaultButton[]},WindowTitle->"Error"];,

(* ***********************Version 1.1******************************** *)
(*IP Version 1.0 Compriance Check*)
Do[
If[Length[save$IP[[n,4]]]==3,AppendTo[save$IP[[n,4]],0]];
If[Length[save$IP[[n,5]]]==3,AppendTo[save$IP[[n,5]],1000]];
,{n,Length[save$IP]}];
(* ***********************Version 1.1******************************** *)

(*---Main Dialog---*)
CreateDialog[{
(*---Title---*)
TextCell[Style["Set Inverted Pendulum",
Bold,Italic,Black],Background->RGBColor[0.6,0.8,0.6]],
(*---New Wire Button---*)
Button[Style["Create New IPs",Bold,White],mod$NewIP,
Appearance->"FramedPalette",Background->Black],
(*---Load Lists---*)
If[ValueQ[save$IP],temp$IP=save$IP,temp$IP={}];
(*---Input Field Module---*)
Dynamic[TableForm[Table[{
With[{n=n},Button[Style["Delete",Small],
temp$IP=Delete[temp$IP,{n}],ImageSize->Small]],
With[{n=n},Button[Style["Copy",Small],
AppendTo[temp$IP,temp$IP[[n]]],ImageSize->Small]],
With[{n=n},Button[Style["Edit",Small],
mod$EditIP[n],ImageSize->Small]],
InputField[With[{n=n},Dynamic[temp$IP[[n,6]]]],String,FieldSize->{8.,1.}],
PopupMenu[With[{n=n},Dynamic[temp$IP[[n,1]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
PopupMenu[With[{n=n},Dynamic[temp$IP[[n,2]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]]},
{n,Length[temp$IP]}],TableHeadings->{None,
{"Del","Copy","Edit","Name","Base","Top"}}]],
(*---Save & Cancel Button---*)
TableForm[{{
Button[Style["Save",Bold],DialogReturn[save$IP=temp$IP]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{800,500},WindowTitle->"2-3 Set Inverted Pendulum"](*Cancel Button*)
];

New Inverted Pendulum

mod$NewIP:=
CreateDialog[{
(*---Title---*)
TextCell[Style["Registrate New Inverted Pendulum",
Bold,Italic,White],Background->Black],
(*---New IP temporary list---*)
temp$newIP={1,2,{{0.6,0},{-0.3,-0.5196},{-0.3,0.5196}},
{200.,200.,200.,200},{10,10,10,1000},"IP",0.5,-80,False,0,True};
(*---Name---*)
TextCell[Style["IP Name",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,1]],
InputField[Dynamic[temp$newIP[[6]]],String,FieldSize->{8.,1.}],
(*---Choose Bodies---*)
TextCell[Style["Choose Base and Top Bodies",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.9]],
TableForm[{{
"Base:",PopupMenu[Dynamic[temp$newIP[[1]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
"Top:",PopupMenu[Dynamic[temp$newIP[[2]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]]}}],
(*---IP Position---*)
TextCell[Style["Position of IPs in Horizontal Plane",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
Button[Style["Calculate IP Position",Bold,Black,Small],
mod$CalcIPPosition,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[
Table[
{InputField[With[{m=m},Dynamic[temp$newIP[[3,m,1]]/mm,
(temp$newIP[[3,m,1]]=#*mm)&]],Number,FieldSize->{5.,1.}],
InputField[With[{m=m},Dynamic[temp$newIP[[3,m,2]]/mm,
(temp$newIP[[3,m,2]]=#*mm)&]],Number,FieldSize->{5.,1.}]},{m,3}],
TableHeadings->{{"Leg1","Leg2","Leg3"},{"x [mm]","z [mm]"}}],
(*---IP Length---*)
TextCell[Style["Length of IP Legs",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
TableForm[{{InputField[Dynamic[temp$newIP[[7]]/mm,(temp$newIP[[7]]=#*mm)&],
Number,FieldSize->{5.,1.}],"mm"}}],
(*---Load Mass---*)
TextCell[Style["Load Mass",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
Button[Style["Calculate from Suspended Bodies",Bold,Black,Small],
mod$CalcIPLoad,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{{InputField[Dynamic[temp$newIP[[10]]],
Number,FieldSize->{5.,1.}],"kg"}}],
(*---Stiffness & Q---*)
TextCell[Style["Effective Stiffness and Quality Factor",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.8]],
Button[Style["Calculate stiffness from Resonant Frequency",Bold,Black,Small],
mod$CalcIPStiff,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[
Table[
{InputField[With[{m=m},Dynamic[temp$newIP[[4,m]]]],Number,FieldSize->{5.,1.}],
InputField[With[{m=m},Dynamic[temp$newIP[[5,m]]]],Number,FieldSize->{5.,1.}]},{m,3}],
TableHeadings->{{"Leg1","Leg2","Leg3"},{"Stiffness [N/m]","Q-factor"}}],
TextCell[Style["Additional yaw stiffness due to Rigidity of flexures",
Bold,Italic,Black]],
TableForm[
Table[
{InputField[With[{m=m},Dynamic[temp$newIP[[4,m]]]],Number,FieldSize->{5.,1.}],
InputField[With[{m=m},Dynamic[temp$newIP[[5,m]]]],Number,FieldSize->{5.,1.}]},{m,4,4}],
TableHeadings->{{"Torsion"},{"Stiffness [Nm/rad]","Q-factor"}}],
(*---Center of Percussion---*)
TextCell[Style["Center of Percussion Level",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.8]],
TableForm[
{{Checkbox[Dynamic[temp$newIP[[11]]]],
InputField[Dynamic[temp$newIP[[8]]],Number,FieldSize->{5.,1.},
Enabled->Dynamic[temp$newIP[[11]]]],"dB"}}],
TableForm[
{{Checkbox[Dynamic[temp$newIP[[9]]]],"Overcompensated"}}],
(*---Create Flexure---*)
TextCell[Style["Finish",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.6]],
TableForm[{{Button[Style["Create",Bold],
DialogReturn[AppendTo[temp$IP,temp$newIP]]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,500},WindowTitle->"New Horizontal Flexure"];

Edit Inverted Pendulum

mod$EditIP[n_]:=
CreateDialog[{
(*---Title---*)
TextCell[Style["Edit Inverted Pendulum",
Bold,Italic,White],Background->Black],
(*---New IP temporary list---*)
temp$newIP=temp$IP[[n]];
(*---Name---*)
TextCell[Style["IP Name",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,1]],
InputField[Dynamic[temp$newIP[[6]]],String,FieldSize->{8.,1.}],
(*---Choose Bodies---*)
TextCell[Style["Choose Base and Top Bodies",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.9]],
TableForm[{{
"Base:",PopupMenu[Dynamic[temp$newIP[[1]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
"Top:",PopupMenu[Dynamic[temp$newIP[[2]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]]}}],
(*---IP Position---*)
TextCell[Style["Position of IPs in Horizontal Plane",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
Button[Style["Calculate IP Position",Bold,Black,Small],
mod$CalcIPPosition,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[
Table[
{InputField[With[{m=m},Dynamic[temp$newIP[[3,m,1]]/mm,
(temp$newIP[[3,m,1]]=#*mm)&]],Number,FieldSize->{5.,1.}],
InputField[With[{m=m},Dynamic[temp$newIP[[3,m,2]]/mm,
(temp$newIP[[3,m,2]]=#*mm)&]],Number,FieldSize->{5.,1.}]},{m,3}],
TableHeadings->{{"Leg1","Leg2","Leg3"},{"x [mm]","z [mm]"}}],
(*---IP Length---*)
TextCell[Style["Length of IP Legs",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
TableForm[{{InputField[Dynamic[temp$newIP[[7]]/mm,(temp$newIP[[7]]=#*mm)&],
Number,FieldSize->{5.,1.}],"mm"}}],
(*---Load Mass---*)
TextCell[Style["Load Mass",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
Button[Style["Calculate from Suspended Bodies",Bold,Black,Small],
mod$CalcIPLoad,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{{InputField[Dynamic[temp$newIP[[10]]],
Number,FieldSize->{5.,1.}],"kg"}}],
(*---Stiffness & Q---*)
TextCell[Style["Effective Stiffness and Quality Factor",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.8]],
Button[Style["Calculate stiffness from Resonant Frequency",Bold,Black,Small],
mod$CalcIPStiff,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[
Table[
{InputField[With[{m=m},Dynamic[temp$newIP[[4,m]]]],Number,FieldSize->{5.,1.}],
InputField[With[{m=m},Dynamic[temp$newIP[[5,m]]]],Number,FieldSize->{5.,1.}]},{m,3}],
TableHeadings->{{"Leg1","Leg2","Leg3"},{"Stiffness [N/m]","Q-factor"}}],
TextCell[Style["Additional yaw stiffness due to Rigidity of flexures",
Bold,Italic,Black]],
TableForm[
Table[
{InputField[With[{m=m},Dynamic[temp$newIP[[4,m]]]],Number,FieldSize->{5.,1.}],
InputField[With[{m=m},Dynamic[temp$newIP[[5,m]]]],Number,FieldSize->{5.,1.}]},{m,4,4}],
TableHeadings->{{"Torsion"},{"Stiffness [Nm/rad]","Q-factor"}}],
(*---Center of Percussion---*)
TextCell[Style["Center of Percussion Level",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.8]],
TableForm[
{{Checkbox[Dynamic[temp$newIP[[11]]]],
InputField[Dynamic[temp$newIP[[8]]],Number,FieldSize->{5.,1.},
Enabled->Dynamic[temp$newIP[[11]]]],"dB"}}],
TableForm[
{{Checkbox[Dynamic[temp$newIP[[9]]]],"Overcompensated"}}],
(*---Create Flexure---*)
TextCell[Style["Finish",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.6]],
TableForm[{{Button[Style["OK",Bold],
DialogReturn[temp$IP[[n]]=temp$newIP]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,500},WindowTitle->"New Horizontal Flexure"];

Calculate IP Position

mod$CalcIPPosition:=CreateDialog[{
(*---Title---*)
TextCell[Style["Calculate IP Position:",
Bold,Black,Italic],Background->RGBColor[.6,.6,.6]],
(*---Input Field Module---*)
temp$IPpos={0.6,0.};
TableForm[{{"Radial Distance from Base Body's CoM:",
InputField[Dynamic[temp$IPpos[[1]]/mm,
(temp$IPpos[[1]]=#*mm)&],Number,FieldSize->{5.,1.}],"mm"},
{"Rotation Angle in Horizontal Plane from x-axis:",
InputField[Dynamic[temp$IPpos[[2]]/deg,
(temp$IPpos[[2]]=#*deg)&],Number,FieldSize->{5.,1.}],"deg"}
}],
(*---OK & Cancel Button---*)
TableForm[{{
Button["OK",DialogReturn[temp$newIP[[3]]=
Table[Delete[mod$SP3wire[0,temp$IPpos[[1]],temp$IPpos[[2]]][[m]],2],{m,3}]]],
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{500,300},WindowTitle->"Calculate IP Position"];

Calculate IP Load

mod$CalcIPLoad:=CreateDialog[{
(*---Title---*)
TextCell[Style["Check the masses suspended by IPs:",
Bold,Black,Italic],Background->RGBColor[.6,.6,.6]],
(*---Logic List---*)
temp$IPload=Table[False,{Length[save$bdn]}];
(*---Check List for Calculation---*)
TableForm[Partition[
Table[{{Checkbox[With[{n=n},Dynamic[temp$IPload[[n]]]]],save$bdn[[n,2]]}},
{n,Length[save$bdn]}],6,6,1,{}]],
(*---Calculator---*)
TableForm[{{"Total Mass:",Dynamic[Sum[If[temp$IPload[[n]],save$mass[[n,1]],0],
{n,Length[save$bdn]}]],"kg"}}],
(*---OK & Cancel Button---*)
TableForm[{{
Button["OK",DialogReturn[temp$newIP[[10]]=
Sum[If[temp$IPload[[n]],save$mass[[n,1]],0],
{n,Length[save$bdn]}]]],
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{400,200},WindowTitle->"Calculate IP Stiffness"];

Calculate IP Stiffness

mod$CalcIPStiff:=CreateDialog[{
(*---Title---*)
TextCell[Style["Calculate IP Position:",
Bold,Black,Italic],Background->RGBColor[.6,.6,.6]],
(*---Input Field Module---*)
temp$IPstiff=0.;
TableForm[{{"Resonant Frequency:",
InputField[Dynamic[temp$IPstiff],Number,FieldSize->{5.,1.}],"Hz"}}],
(*---OK & Cancel Button---*)
TableForm[{{
Button["OK",DialogReturn[
Do[temp$newIP[[4,m]]=temp$newIP[[10]]*(2*N[Pi]*temp$IPstiff)^2/3,{m,3}]]],
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{500,300},WindowTitle->"Calculate IP Position"];

(2-3 Set Horizontal Flexure)

Set Vertical Springs

mod$SetHorizFlex:=
(*---Check Previous Setting---*)
If[Not[ValueQ[save$bdn]],(*If body names have not been set yet, return error*)
Beep[];CreateDialog[{"Registrate bodies first.",DefaultButton[]},WindowTitle->"Error"];,
(*---Main Dialog---*)
CreateDialog[{
If[Not[ValueQ[save$mat]],save$mat=list$Material];
(*---Title---*)
TextCell[Style["Set Horizontal Flexure",
Bold,Italic,Black],Background->RGBColor[0.6,0.8,0.6]],
(*---New Wire Button---*)
Button[Style["Create New Flexure",Bold,White],mod$NewHorizFlex,
Appearance->"FramedPalette",Background->Black],
(*---Load Lists---*)
If[ValueQ[save$hflex],temp$hflex=save$hflex,temp$hflex={}];
(*---Input Field Module---*)
Dynamic[TableForm[Table[{
With[{n=n},Button[Style["Delete",Small],
temp$hflex=Delete[temp$hflex,{n}],ImageSize->Small]],
With[{n=n},Button[Style["Copy",Small],
AppendTo[temp$hflex,temp$hflex[[n]]],ImageSize->Small]],
InputField[With[{n=n},Dynamic[temp$hflex[[n,6]]]],String,FieldSize->{8.,1.}],
PopupMenu[With[{n=n},Dynamic[temp$hflex[[n,1]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
PopupMenu[With[{n=n},Dynamic[temp$hflex[[n,2]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
InputField[With[{n=n},Dynamic[temp$hflex[[n,3]]]],Number,FieldSize->{5.,1.}],
PopupMenu[With[{n=n},Dynamic[temp$hflex[[n,7]]]],
Table[m->save$mat[[m,1]],{m,Length[save$mat]}]],
InputField[With[{n=n},Dynamic[temp$hflex[[n,4]]/mm,
(temp$hflex[[n,4]]=#*mm)&]],Number,FieldSize->{5.,1.}],
TableForm[{Table[InputField[With[{n=n,m=m},Dynamic[temp$hflex[[n,5,m]]/mm,
(temp$hflex[[n,5,m]]=#*mm)&]],Number,FieldSize->{5.,1.}],{m,3}]}]
},{n,Length[temp$hflex]}],TableHeadings->{None,
{"Del","Copy","Name","Base","Follower","Stiffness [Nm/rad]","Material",
"Follower's CoM H[mm]","Position in Base [mm]"}}]],
(*---Save & Cancel Button---*)
TableForm[{{
Button[Style["Save",Bold],DialogReturn[save$hflex=temp$hflex]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},WindowSize->{800,500},WindowTitle->"2-3 Set Horizontal Flexures"](*Cancel Button*)
];

New Flexure

mod$NewHorizFlex:=
CreateDialog[{
(*---Title---*)
TextCell[Style["Registrate New Horizontal Flexure",
Bold,Italic,White],Background->Black],
(*---New flexure temporary list---*)
temp$newhflex={1,2,0.,0.02,{0.,0.,0.},"",1};
(*---Name---*)
TextCell[Style["Flexure Name",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,1]],
InputField[Dynamic[temp$newhflex[[6]]],String,FieldSize->{8.,1.}],
(*---Choose Bodies---*)
TextCell[Style["Choose rigid bodies where the flexure is attached.",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.9]],
TableForm[{{
"Base:",PopupMenu[Dynamic[temp$newhflex[[1]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
"Follower:",PopupMenu[Dynamic[temp$newhflex[[2]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]]}}],
(*---Material---*)
TextCell[Style["Material of Flexure",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.85]],
PopupMenu[Dynamic[temp$newhflex[[7]]],
Table[m->save$mat[[m,1]],{m,Length[save$mat]}]],
(*---Stiffness---*)
TextCell[Style["Stiffness",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.8]],
Button[Style["Calculate flexure stiffness from resonant frequency",Bold,Black,Small],
mod$CalcFlexStiff,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{{"Stiffness:",InputField[Dynamic[temp$newhflex[[3]]],Number,FieldSize->{5.,1.}],"Nm/rad"}}],
(*---Position of Follower---*)
TextCell[Style["Height of Follower's CoM from Flexure",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
Button[Style["Calculate CoM Position from CoP Level",Bold,Black,Small],
mod$CalcFlexStiff,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{{InputField[Dynamic[temp$newhflex[[4]]/mm,
(temp$newhflex[[4]]=#*mm)&],Number,FieldSize->{5.,1.}],"mm"}}],
(*---Position of Base---*)
TextCell[Style["Position of Flexure in Base Body",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
Button[Style["Calculate Flexure Position",Bold,Black,Small],
mod$CalcFlexPosition,Appearance->"FramedPalette",Background->RGBColor[.8,.8,.8]],
TableForm[{Table[InputField[With[{m=m},
Dynamic[temp$newhflex[[5,m]]/mm,(temp$newhflex[[5]]=#*mm)&]],Number,FieldSize->{5.,1.}],{m,3}]}],
(*---Create Flexure---*)
TextCell[Style["Finish",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.6]],
TableForm[{{Button[Style["Create",Bold],
DialogReturn[AppendTo[temp$hflex,temp$newhflex]]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,500},WindowTitle->"New Horizontal Flexure"];

Calculate Flexure Position

mod$CalcFlexPosition:=CreateDialog[{
(*---Title---*)
TextCell[Style["Calculate Flexure Position:",
Bold,Black,Italic],Background->RGBColor[.6,.6,.6]],
(*---Input Field Module---*)
temp$hflexpos={0.6,0.,0.01};
TableForm[{{"Radial Distance from Base Body's CoM:",
InputField[Dynamic[temp$hflexpos[[1]]/mm,
(temp$hflexpos[[1]]=#*mm)&],Number,FieldSize->{5.,1.}],"mm"},
{"Rotation Angle in Horizontal Plane from x-axis:",
InputField[Dynamic[temp$hflexpos[[2]]/deg,
(temp$hflexpos[[2]]=#*deg)&],Number,FieldSize->{5.,1.}],"deg"},
{"Height from Base Body's CoM:",
InputField[Dynamic[temp$hflexpos[[3]]/mm,
(temp$hflexpos[[3]]=#*mm)&],Number,FieldSize->{5.,1.}],"mm"}
}],
(*---OK & Cancel Button---*)
TableForm[{{
Button["OK",DialogReturn[temp$newhflex[[5]]=
mod$SP3wire[temp$hflexpos[[3]],temp$hflexpos[[1]],temp$hflexpos[[2]]][[1]]]],
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{500,300},WindowTitle->"Calculate Flexure Position"];

Calculate Stiffness & Follower's Height

mod$CalcFlexStiff:=CreateDialog[{
(*---Title---*)
TextCell[Style["Calculate Flexure Stiffness & Follower's CoM Height:",
Bold,White,Italic],Background->RGBColor[0,0,0]],
(*---Input Field Module---*)
temp$hflexStiff={0.,save$mass[[temp$newhflex[[2]],1]],
save$mass[[temp$newhflex[[2]],2,1,1]],0.5,0.03,-80,False};
(*---Logic List---*)
temp$hflexLogic=Table[True,{Length[save$bdn]}];
temp$hflexLegNum=1;
(*---Load Caocluation---*)
(*Check List*)
TextCell[Style["Calculate Load on IP (exclude leg):",
Bold,Black,Italic],Background->RGBColor[.7,.6,.6]],
TableForm[Partition[
Table[{{Checkbox[With[{n=n},Dynamic[temp$hflexLogic[[n]]]]],save$bdn[[n,2]]}},
{n,Length[save$bdn]}],6,6,1,{}]],
(*Calculator*)
TableForm[{{"How many legs?",
InputField[Dynamic[temp$hflexLegNum],Number,FieldSize->{2.,1.}]}}],
TableForm[{{
Button[Style["Calculate from body's mass",Black,Small,Bold],
temp$hflexStiff[[1]]=Sum[If[temp$hflexLogic[[n]],save$mass[[n,1]],0],
{n,Length[save$bdn]}]/temp$hflexLegNum],
InputField[Dynamic[temp$hflexStiff[[1]]],Number,FieldSize->{5.,1.}],"kg"}}],
(*---Leg's Mass, MoI and Length---*)
TextCell[Style["Leg's Mass, MoI and Length:",
Bold,Black,Italic],Background->RGBColor[.6,.7,.6]],
TableForm[{{"Mass:",InputField[Dynamic[temp$hflexStiff[[2]]],Number,FieldSize->{5.,1.}],"kg"},
{"MoI:",InputField[Dynamic[temp$hflexStiff[[3]]],Number,FieldSize->{5.,1.}],"kg*m2"},
{"Length:",InputField[Dynamic[temp$hflexStiff[[4]]/mm,
(temp$hflexStiff[[4]]=#*mm)&],Number,FieldSize->{5.,1.}],"mm"}}],
(*---Resonant Frequency and CoP Effect---*)
TextCell[Style["Resonant Freqeuncy & CoP Effect:",
Bold,Black,Italic],Background->RGBColor[.6,.6,.7]],
TableForm[{{"Frequency:",InputField[Dynamic[temp$hflexStiff[[5]]],Number,FieldSize->{5.,1.}],"Hz"},
{"CoP Level:",InputField[Dynamic[temp$hflexStiff[[6]]],Number,FieldSize->{5.,1.}],"dB"}}],
TableForm[{{Checkbox[Dynamic[temp$hflexStiff[[7]]]],"Over compensated?"}}],
(*---OK & Cancel Button---*)
TextCell[Style["Calculate",
Bold,White,Italic],Background->RGBColor[0,0,0]],
TableForm[{{
Button[Style["Calculate",Bold],
Module[{m,mI,M,y,B,L,w},
L=temp$hflexStiff[[4]];m=temp$hflexStiff[[2]];M=temp$hflexStiff[[1]];
w=2*N[Pi]*temp$hflexStiff[[5]];
mI=temp$hflexStiff[[3]]/L^2;B=If[temp$hflexStiff[[7]],-1,+1]*10^(temp$hflexStiff[[6]]/20);
If[(m^2-4*m*(1+B)*(B*M+(1+B)*mI))>0,
DialogReturn[y=(m-Sqrt[m^2-4*m*(1+B)*(B*M+(1+B)*mI)])/(2*m*(1+B));
temp$newhflex[[4]]=y*L;temp$newhflex[[3]]=((M+y*m)*g/L+(M+m*y^2+mI)*w^2)*L^2;],
Beep[];CreateDialog[{"Too large CoP Effect.",DefaultButton[]},WindowTitle->"Error"]]]],
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{500,500},WindowTitle->"Calculate Flexure Information"];

2-4 Set Heat Links

Set HL

mod$SetHeatLinks:=
(*---Check Previous Setting---*)
If[Not[ValueQ[save$bdn]]||Not[ValueQ[save$shape]],(*If bodies have not been set yet, return error*)
Beep[];CreateDialog[{"Registrate bodies first.",DefaultButton[]},WindowTitle->"Error"];,
(*---Main Dialog---*)
CreateDialog[{
(*---Title---*)
TextCell[Style["Set Heat Links",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
(*---New HL Button---*)
Button[Style["Create New Heat Links",Bold,White],mod$NewHeatLinks,
Appearance->"FramedPalette",Background->Black],
(*---Load Lists---*)
If[ValueQ[save$HL],temp$HL=save$HL,temp$HL={}];
(*---Input Field Module---*)
Dynamic[TableForm[Table[{
With[{n=n},Button[Style["Delete",Small],
temp$HL=Delete[temp$HL,{n}],ImageSize->Small]],
With[{n=n},Button[Style["Copy",Small],
AppendTo[temp$HL,temp$HL[[n]]],ImageSize->Small]],
With[{n=n},Button[Style["Edit",Small],mod$EditHeatLinks[n],ImageSize->Small]],
InputField[With[{n=n},Dynamic[temp$HL[[n,10]]]],String,FieldSize->{8.,1.}],
PopupMenu[With[{n=n},Dynamic[temp$HL[[n,1]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
PopupMenu[With[{n=n},Dynamic[temp$HL[[n,2]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
TableForm[{Table[InputField[With[{n=n,m=m},Dynamic[temp$HL[[n,3,m]]/mm,
(temp$HL[[n,3,m]]=#*mm)&]],Number,FieldSize->{5.,1.}],{m,3}]}],
TableForm[{Table[InputField[With[{n=n,m=m},Dynamic[temp$HL[[n,4,m]]/mm,
(temp$HL[[n,4,m]]=#*mm)&]],Number,FieldSize->{5.,1.}],{m,3}]}],
InputField[With[{n=n},Dynamic[temp$HL[[n,5,1]]/mm,
(temp$HL[[n,5,1]]=#*mm)&]],Number,FieldSize->{5.,1.}],
InputField[With[{n=n},Dynamic[temp$HL[[n,5,2]]/mm,
(temp$HL[[n,5,2]]=#*mm)&]],Number,FieldSize->{5.,1.}],
InputField[With[{n=n},Dynamic[temp$HL[[n,5,3]]/mm,
(temp$HL[[n,5,3]]=#*mm)&]],Number,FieldSize->{5.,1.}]
},{n,Length[temp$HL]}],TableHeadings->{None,
{"Del","Copy","Edit","Name","Body1","Body2","Attachment Point in Body1 [mm]",
"Attachment Point in Body2 [mm]","Geo-x [mm]","Geo-y [mm]","Geo-z [mm]"}}]],
(*---Save & Cancel Button---*)
TableForm[{{
Button[Style["Save",Bold],DialogReturn[save$HL=temp$HL]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},WindowSize->{800,500},WindowTitle->"2-4 Set Heat Links"](*Cancel Button*)
];

New HL

mod$NewHeatLinks:=
CreateDialog[{
(*---Title---*)
TextCell[Style["New Heat Links",
Bold,Italic,White],Background->Black],
(*---New flexure temporary list---*)
temp$newHL={1,2,{0.,0.,0.},{0.,0.,0.},{0.6,0.3,0.},1,100.,
Table[0,{6},{6}],Table["",{6},{6}],""};
(*---Name---*)
TextCell[Style["Name",
Bold,Italic,Black],Background->RGBColor[1,0.6,0.6]],
InputField[Dynamic[temp$newHL[[10]]],String,FieldSize->{8.,1.}],
(*---Bodies---*)
TextCell[Style["Select Attached Bodies",
Bold,Italic,Black],Background->RGBColor[0.9,0.6,0.6]],
TableForm[{
{"Body1:",PopupMenu[Dynamic[temp$newHL[[1]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
"Body2:",PopupMenu[Dynamic[temp$newHL[[2]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]]}}],
(*---Geometry---*)
TextCell[Style["Clamp Position and Heat Link Geometry",
Bold,Italic,Black],Background->RGBColor[0.9,0.6,0.6]],
TableForm[{{
TableForm[{
{"",Style["x",Small],Style["y",Small],Style["z",Small]},
Join[{"Body1:"},Table[InputField[With[{m=m},
Dynamic[temp$newHL[[3,m]]/mm,(temp$newHL[[3,m]]=#*mm)&]],
Number,FieldSize->{5.,1.}],{m,3}]],
{"",Style["x",Small],Style["y",Small],Style["z",Small]},
Join[{"Body2:"},Table[InputField[With[{m=m},
Dynamic[temp$newHL[[4,m]]/mm,(temp$newHL[[4,m]]=#*mm)&]],
Number,FieldSize->{5.,1.}],{m,3}]],
{"",Style["x-Distance",Small],Style["y-Depth",Small],Style["z-Distance",Small]},
Join[{"Geometry"},Table[InputField[With[{m=m},
Dynamic[temp$newHL[[5,m]]/mm,(temp$newHL[[5,m]]=#*mm)&]],
Number,FieldSize->{5.,1.}],{m,3}]]
}],
Dynamic[Show[Graphics3D[mod$DrawHeatLinks,
{ViewPoint->{10,10,50},ViewVertical->{0,1,0}}],ImageSize->200]]
}}],
(*---Stiffness---*)
TextCell[Style["Stiffness Matrix for Each Wire",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.8]],
TableForm[{{Style["Number of Wires:",Bold],
InputField[Dynamic[temp$newHL[[6]]],Number,FieldSize->{5.,1.}],"",
Style["Q-factor:",Bold],
InputField[Dynamic[temp$newHL[[7]]],Number,FieldSize->{5.,1.}]}}],
TableForm[Table[
TableForm[
{TableForm[{{
With[{m=m,l=l},Button[Style["Import",Small,Bold],mod$ImportkHL[m,l],
Appearance->"FramedPalette",Background->GrayLevel[.8]]],
InputField[With[{m=m,l=l},Dynamic[temp$newHL[[8,m,l]]]],Number,FieldSize->{5.,1.}]}}],
InputField[With[{m=m,l=l},Dynamic[temp$newHL[[9,m,l]]]],String,
FieldSize->{10.,1.},Enabled->False]}],
{l,6},{m,6}],TableHeadings->Table[{"x","y","z","Pitch","Yaw","Roll"},{2}]],
(*---Create Flexure---*)
TextCell[Style["Finish",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.6]],
TableForm[{{Button[Style["Create",Bold],
DialogReturn[AppendTo[temp$HL,temp$newHL]]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{800,500},WindowTitle->"New Heat Links"];

Edit HL

mod$EditHeatLinks[n_]:=
CreateDialog[{
(*---Title---*)
TextCell[Style["Edit Heat Links",
Bold,Italic,White],Background->Black],
(*---New flexure temporary list---*)
temp$newHL=temp$HL[[n]];
(*---Name---*)
TextCell[Style["Name",
Bold,Italic,Black],Background->RGBColor[1,0.6,0.6]],
InputField[Dynamic[temp$newHL[[10]]],String,FieldSize->{8.,1.}],
(*---Bodies---*)
TextCell[Style["Select Attached Bodies",
Bold,Italic,Black],Background->RGBColor[0.9,0.6,0.6]],
TableForm[{
{"Body1:",PopupMenu[Dynamic[temp$newHL[[1]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
"Body2:",PopupMenu[Dynamic[temp$newHL[[2]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]]}}],
(*---Geometry---*)
TextCell[Style["Clamp Position and Heat Link Geometry",
Bold,Italic,Black],Background->RGBColor[0.9,0.6,0.6]],
TableForm[{{
TableForm[{
{"",Style["x",Small],Style["y",Small],Style["z",Small]},
Join[{"Body1:"},Table[InputField[With[{m=m},
Dynamic[temp$newHL[[3,m]]/mm,(temp$newHL[[3,m]]=#*mm)&]],
Number,FieldSize->{5.,1.}],{m,3}]],
{"",Style["x",Small],Style["y",Small],Style["z",Small]},
Join[{"Body2:"},Table[InputField[With[{m=m},
Dynamic[temp$newHL[[4,m]]/mm,(temp$newHL[[4,m]]=#*mm)&]],
Number,FieldSize->{5.,1.}],{m,3}]],
{"",Style["x-Distance",Small],Style["y-Depth",Small],Style["z-Distance",Small]},
Join[{"Geometry"},Table[InputField[With[{m=m},
Dynamic[temp$newHL[[5,m]]/mm,(temp$newHL[[5,m]]=#*mm)&]],
Number,FieldSize->{5.,1.}],{m,3}]]
}],
Dynamic[Show[Graphics3D[mod$DrawHeatLinks,
{ViewPoint->{10,10,50},ViewVertical->{0,1,0}}],ImageSize->200]]
}}],
(*---Stiffness---*)
TextCell[Style["Stiffness Matrix for Each Wire",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.8]],
TableForm[{{Style["Number of Wires:",Bold],
InputField[Dynamic[temp$newHL[[6]]],Number,FieldSize->{5.,1.}],"",
Style["Q-factor:",Bold],
InputField[Dynamic[temp$newHL[[7]]],Number,FieldSize->{5.,1.}]}}],
TableForm[Table[
TableForm[
{TableForm[{{
With[{m=m,l=l},Button[Style["Import",Small,Bold],mod$ImportkHL[m,l],
Appearance->"FramedPalette",Background->GrayLevel[.8]]],
InputField[With[{m=m,l=l},Dynamic[temp$newHL[[8,m,l]]]],Number,FieldSize->{5.,1.}]}}],
InputField[With[{m=m,l=l},Dynamic[temp$newHL[[9,m,l]]]],String,
FieldSize->{10.,1.},Enabled->False]}],
{l,6},{m,6}],TableHeadings->Table[{"x","y","z","Pitch","Yaw","Roll"},{2}]],
(*---Create Flexure---*)
TextCell[Style["Finish",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.6]],
TableForm[{{Button[Style["Create",Bold],
DialogReturn[temp$HL[[n]]=temp$newHL]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{800,500},WindowTitle->"Edit Heat Links"];

Draw HL

mod$DrawHeatLinks:=
Module[{rCM={0,0,0}},
{Line[
Table[temp$newHL[[3]]+{temp$newHL[[5,1]],0,temp$newHL[[5,3]]}/2-
{temp$newHL[[5,1]]*Cos[N[Pi]*i/20],2*temp$newHL[[5,2]]*Sin[N[Pi]*i/20],
temp$newHL[[5,3]]*Cos[N[Pi]*i/20]}/2,{i,0,20}]],
Opacity[0.5],
mod$Create3DShape[rCM-temp$newHL[[3]],save$shape[[temp$newHL[[1]],1]],save$shape[[temp$newHL[[1]],2]]],
mod$Create3DShape[rCM-temp$newHL[[4]]+{temp$newHL[[5,1]],0,temp$newHL[[5,3]]},
save$shape[[temp$newHL[[2]],1]],save$shape[[temp$newHL[[2]],2]]]
}
];

steadyplot[sub_,opt___]:=
Show[
wireplot[sub],
bodyplot[sub],
heatlinkplot[sub],
opt
];

heatlinkplot[sub_]:=
If[save$HL[[0]]=!=List,{},
Table[
Graphics3D[Line[
Table[b2s[save$bodypos[[save$HL[[n,1]]]],save$HL[[n,3]]]*(1+Cos[N[Pi]*i/20])/2+
b2s[save$bodypos[[save$HL[[n,2]]]],save$HL[[n,4]]]*(1-Cos[N[Pi]*i/20])/2-
{0,save$HL[[n,5,2]],0}*Sin[N[Pi]*i/20],{i,0,20}]]/.subdefparams/.sub],
{n,Length[save$HL]}
]
];

Import kHL

mod$ImportkHL[m_,l_]:=
CreateDialog[{
temp$impkHL=temp$newHL[[9,m,l]];
TextCell[Style["Load Frequency Dependence of Heat Link Stiffness",
Bold,Italic,White],Background->RGBColor[0,0,0]],
Style["File Name:",Bold,Italic],
TableForm[{{InputField[Dynamic[temp$impkHL],String,FieldSize->{20.,1.},Enabled->False],
Button[Style["Load",Bold,White],
DialogReturn[temp$newHL[[9,m,l]]=temp$impkHL],
Appearance->"FramedPalette",Background->Black],
Button[Style["Clear",Bold,Black],temp$impkHL="",
Appearance->"FramedPalette",Background->White],
Button[Style["Cancel",Bold],DialogReturn[],
Appearance->"FramedPalette",Background->GrayLevel[.8]]}}],
Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.txt",{"HeatLink"},3][[n]],9],
temp$impkHL=StringDrop[StringDrop[FileNames["*.txt",{"HeatLink"},3][[n]],9],-4],
Appearance->"Frameless",Alignment->Left,ImageSize->150]],
{n,Length[FileNames["*.txt",{"HeatLink"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{500,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{550,500},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Load Frequency Dependence of Heat Link Stiffness"
];

2-5 Set Damper

Set Damper

mod$SetDamper:=
(*---Check Previous Setting---*)
If[Not[ValueQ[save$bdn]],(*If bodies have not been set yet, return error*)
Beep[];CreateDialog[{"Registrate bodies first.",DefaultButton[]},WindowTitle->"Error"];,
(*---Main Dialog---*)
CreateDialog[{
(*---Title---*)
TextCell[Style["Set Damper",
Bold,Italic,Black],Background->RGBColor[0.6,0.7,0.6]],
(*---New HL Button---*)
Button[Style["Create New Damper",Bold,White],mod$NewDamper,
Appearance->"FramedPalette",Background->Black],
(*---Load Lists---*)
If[ValueQ[save$damp],temp$damp=save$damp,temp$damp={}];
(*---Input Field Module---*)
Dynamic[TableForm[Table[{
With[{n=n},Button[Style["Delete",Small],
temp$damp=Delete[temp$damp,{n}],ImageSize->Small]],
With[{n=n},Button[Style["Copy",Small],
AppendTo[temp$damp,temp$damp[[n]]],ImageSize->Small]],
With[{n=n},Button[Style["Edit",Small],mod$EditDamper[n],ImageSize->Small]],
InputField[With[{n=n},Dynamic[temp$damp[[n,1]]]],String,FieldSize->{8.,1.}],
PopupMenu[With[{n=n},Dynamic[temp$damp[[n,2]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
PopupMenu[With[{n=n},Dynamic[temp$damp[[n,3]]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
TableForm[{Table[InputField[With[{n=n,m=m},Dynamic[temp$damp[[n,4,m]]/mm,
(temp$damp[[n,4,m]]=#*mm)&]],Number,FieldSize->{5.,1.}],{m,3}]}],
TableForm[{Table[InputField[With[{n=n,m=m},Dynamic[temp$damp[[n,5,m]]/mm,
(temp$damp[[n,5,m]]=#*mm)&]],Number,FieldSize->{5.,1.}],{m,3}]}]
},{n,Length[temp$damp]}],TableHeadings->{None,
{"Del","Copy","Edit","Name","Body1","Body2","Damping Point in Body1 [mm]",
"Damping Point in Body2 [mm]"}}]],
(*---Save & Cancel Button---*)
TableForm[{{
Button[Style["Save",Bold],DialogReturn[save$damp=temp$damp]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},WindowSize->{800,500},WindowTitle->"2-5 Set Damper"](*Cancel Button*)
];

New Damper

mod$NewDamper:=
CreateDialog[{
(*---Title---*)
TextCell[Style["New Damper",
Bold,Italic,White],Background->Black],
(*---New flexure temporary list---*)
temp$newdamp={"",1,2,{0.,0.,0.},{0.,0.,0.},Table[0,{6},{6}]};
(*---Name---*)
TextCell[Style["Name",
Bold,Italic,Black],Background->RGBColor[1,0.6,0.6]],
InputField[Dynamic[temp$newdamp[[1]]],String,FieldSize->{8.,1.}],
(*---Bodies---*)
TextCell[Style["Damping Between:",
Bold,Italic,Black],Background->RGBColor[0.9,0.6,0.6]],
TableForm[{
{"Body1:",PopupMenu[Dynamic[temp$newdamp[[2]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
"Body2:",PopupMenu[Dynamic[temp$newdamp[[3]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]]}}],
(*---Geometry---*)
TextCell[Style["Position of Damper",
Bold,Italic,Black],Background->RGBColor[0.9,0.6,0.6]],
TableForm[{
{"",Style["x",Small],Style["y",Small],Style["z",Small]},
Join[{"Body1:"},Table[InputField[With[{m=m},
Dynamic[temp$newdamp[[4,m]]/mm,(temp$newdamp[[4,m]]=#*mm)&]],
Number,FieldSize->{5.,1.}],{m,3}]],
{"",Style["x",Small],Style["y",Small],Style["z",Small]},
Join[{"Body2:"},Table[InputField[With[{m=m},
Dynamic[temp$newdamp[[5,m]]/mm,(temp$newdamp[[5,m]]=#*mm)&]],
Number,FieldSize->{5.,1.}],{m,3}]]}],
(*---Stiffness---*)
TextCell[Style["Damping Strength Matrix",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.8]],
TableForm[Table[
InputField[With[{m=m,l=l},Dynamic[temp$newdamp[[6,m,l]]]],Number,
FieldSize->{5.,1.}],
{l,6},{m,6}],TableHeadings->Table[{"x","y","z","Pitch","Yaw","Roll"},{2}]],
(*---Create Flexure---*)
TextCell[Style["Finish",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.6]],
TableForm[{{Button[Style["Create",Bold],
DialogReturn[AppendTo[temp$damp,temp$newdamp]]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{800,500},WindowTitle->"New Heat Links"];

Edit Damper

mod$EditDamper[n_]:=
CreateDialog[{
(*---Title---*)
TextCell[Style["New Damper",
Bold,Italic,White],Background->Black],
(*---New flexure temporary list---*)
temp$newdamp=temp$damp[[n]];
(*---Name---*)
TextCell[Style["Name",
Bold,Italic,Black],Background->RGBColor[1,0.6,0.6]],
InputField[Dynamic[temp$newdamp[[1]]],String,FieldSize->{8.,1.}],
(*---Bodies---*)
TextCell[Style["Damping Between:",
Bold,Italic,Black],Background->RGBColor[0.9,0.6,0.6]],
TableForm[{
{"Body1:",PopupMenu[Dynamic[temp$newdamp[[2]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]],
"Body2:",PopupMenu[Dynamic[temp$newdamp[[3]]],
Table[m->save$bdn[[m,2]],{m,Length[save$bdn]}]]}}],
(*---Geometry---*)
TextCell[Style["Position of Damper",
Bold,Italic,Black],Background->RGBColor[0.9,0.6,0.6]],
TableForm[{
{"",Style["x",Small],Style["y",Small],Style["z",Small]},
Join[{"Body1:"},Table[InputField[With[{m=m},
Dynamic[temp$newdamp[[4,m]]/mm,(temp$newdamp[[4,m]]=#*mm)&]],
Number,FieldSize->{5.,1.}],{m,3}]],
{"",Style["x",Small],Style["y",Small],Style["z",Small]},
Join[{"Body2:"},Table[InputField[With[{m=m},
Dynamic[temp$newdamp[[5,m]]/mm,(temp$newdamp[[5,m]]=#*mm)&]],
Number,FieldSize->{5.,1.}],{m,3}]]}],
(*---Stiffness---*)
TextCell[Style["Damping Strength Matrix",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.8]],
TableForm[Table[
InputField[With[{m=m,l=l},Dynamic[temp$newdamp[[6,m,l]]]],Number,
FieldSize->{5.,1.}],
{l,6},{m,6}],TableHeadings->Table[{"x","y","z","Pitch","Yaw","Roll"},{2}]],
(*---Create Flexure---*)
TextCell[Style["Finish",
Bold,Italic,Black],Background->RGBColor[0.6,0.6,0.6]],
TableForm[{{Button[Style["Create",Bold],
DialogReturn[temp$damp[[n]]=temp$newdamp]],(*Save Button*)
Button["Cancel",DialogReturn[]]}}]},
(*---Dialog Window Setting---*)
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{800,500},WindowTitle->"New Heat Links"];

2-L Show Connection List

Show Connection List

mod$ShowConnectionList:=
Dynamic[Pane[
TableForm[{
(*---wire---*)
Style["Wire:",RGBColor[0.6,0,0],Bold],
If[ValueQ[save$wire]&&Not[save$wire==={}],
TableForm[Table[
{save$wire[[n,13]],
save$bdn[[save$wire[[n,1]],2]],
save$bdn[[save$wire[[n,3]],2]],
save$mat[[save$wire[[n,5]],1]],
save$wire[[n,6]]/meter,
save$wire[[n,7]]/mm
},
{n,Length[save$wire]}],
TableHeadings->{None,Map[(Style[#,RGBColor[0,0,0.6]])&,
{"Name","Body1","Body2","Material","L [m]","D [mm]"}]}],
save$wire;"No Data"],
"",
(*---spring---*)
Style["Vertical Spring:",RGBColor[0.6,0,0],Bold],
If[ValueQ[save$vspr]&&Not[save$vspr==={}],
TableForm[Table[
{save$vspr[[n,8]],
save$bdn[[save$wire[[save$vspr[[n,1]],1]],2]],
save$bdn[[save$wire[[save$vspr[[n,1]],3]],2]],
save$vspr[[n,3]],
save$vspr[[n,4]],
save$vspr[[n,9]]
},
{n,Length[save$vspr]}],
TableHeadings->{None,Map[(Style[#,RGBColor[0,0,0.6]])&,
{"Name","Body1","Body2","k [N/m]","fp [N]","Q"}]}],
save$vspr;"No Data"],
"",
(*---IP---*)
Style["Inverted Pendulum:",RGBColor[0.6,0,0],Bold],
If[ValueQ[save$IP]&&Not[save$IP==={}],
TableForm[Table[
{save$IP[[n,6]],
save$bdn[[save$IP[[n,1]],2]],
save$bdn[[save$IP[[n,2]],2]]
},
{n,Length[save$IP]}],
TableHeadings->{None,Map[(Style[#,RGBColor[0,0,0.6]])&,
{"Name","Body1","Body2"}]}],
save$IP;"No Data"],
"",
(*---HL---*)
Style["Heat Link:",RGBColor[0.6,0,0],Bold],
If[ValueQ[save$HL]&&Not[save$HL==={}],
TableForm[Table[
{save$HL[[n,10]],
save$bdn[[save$HL[[n,1]],2]],
save$bdn[[save$HL[[n,2]],2]],
save$HL[[n,5,1]]/mm,
save$HL[[n,5,2]]/mm,
save$HL[[n,5,3]]/mm
},
{n,Length[save$HL]}],
TableHeadings->{None,Map[(Style[#,RGBColor[0,0,0.6]])&,
{"Name","Body1","Body2","x [mm]","y [mm]","z [mm]"}]}],
save$HL;"No Data"],
"",
(*---Damper---*)
Style["Damper:",RGBColor[0.6,0,0],Bold],
If[ValueQ[save$damp]&&Not[save$damp==={}],
TableForm[Table[
{save$damp[[n,1]],
save$bdn[[save$damp[[n,2]],2]],
save$bdn[[save$damp[[n,3]],2]]
},
{n,Length[save$damp]}],
TableHeadings->{None,Map[(Style[#,RGBColor[0,0,0.6]])&,
{"Name","Body1","Body2"}]}],
save$HL;"No Data"]
}],
Scrollbars->True,ImageSize->{640,300},AppearanceElements->None]];

3. Start Calculation

Start Calc

Start Calc

mod$StartCalc:=(
mod$OpenStatus;
mod$WriteStatus["Compliance check..."];
mod$CheckModel;
If[Not[calc$sflag==0],
mod$WriteStatus["Stop Calculation"];
mod$StartSUMCON;,

mod$WriteStatus["Compliance check: OK."];
mod$WriteStatus["Model construction starts..."];
mod$WriteStatus["Setting variables..."];
mod$SetVars;
mod$WriteStatus["Variables have been set."];
mod$WriteStatus["Setting body positions..."];
mod$SetBodyPos;
mod$WriteStatus["Body positions have been set."];
mod$WriteStatus["Generating necessary lists..."];
mod$SetList;
mod$WriteStatus["Bodylist, wirelist, damperlist have been set."];
mod$WriteStatus["Calculating energy terms..."];
mod$CalcEnergy;
mod$WriteStatus["Energy terms have been set."];
mod$WriteStatus["Setting initial values of variables..."];
mod$SetInitVal;
mod$WriteStatus["Initial conditions have been set."];
mod$WriteStatus["Finding equilibrium position..."];
mod$FindEquilibrium;
mod$WriteStatus["Equilibrium position has been set."];
mod$WriteStatus["Start linearization:"];
mod$CalcMatrices;
mod$WriteStatus["Matrices have been set."];
mod$WriteStatus["Calculating eigen modes..."];
mod$EigenCalc;
mod$WriteStatus["Eigen modes have been set."];
(*mod$WriteStatus["Now opening calculation menu..."];
mod$CalcMenu;*)
mod$CloseStatus;
];
);

Check Model

Check Model

mod$CheckModel:=(
Module[{bdnt,bdnc},
calc$sflag=0;

(*Body Name*)
If[save$bdn[[0]]===Symbol||save$bdn==={},
mod$WriteError["Bodies are not registered yet."];calc$sflag=1];
If[Not[MemberQ[save$bdn[[All,1]],True]],
mod$WriteError["You need at least one 'ground' body."];calc$sflag=1];
If[Not[MemberQ[save$bdn[[All,1]],False]],
mod$WriteError["You need at least one non-ground body."];calc$sflag=1];
bdnt=Tally[save$bdn[[All,2]]][[All,2]];
bdnc=Table[bdnt[[n]]==1,{n,Length[bdnt]}];
If[MemberQ[bdnc,False],
mod$WriteError["Duplicated body names found."];calc$sflag=1];
];

(*Mass*)
If[save$mass[[0]]===Symbol||save$mass==={},
mod$WriteError["Mass and moment of inertia are not registered yet."];calc$sflag=1];
If[Length[save$bdn]>Length[save$mass],
mod$WriteError["Mass and moment of inertia are not registered completely."];calc$sflag=1];

(*Body Shape*)
If[save$mass[[0]]===Symbol||save$mass==={},
mod$WriteError["Body shapes are not registered yet."];calc$sflag=1];
If[Length[save$bdn]>Length[save$shape],
mod$WriteError["Body shapes are not registered completely."];calc$sflag=1];

(*Body Position*)
If[save$initpos[[0]]===Symbol||save$initpos==={},
mod$WriteError["Body initial positions are not registered yet."];calc$sflag=1];
If[Length[save$bdn]>Length[save$initpos],
mod$WriteError["Body initial positions are not registered completely."];calc$sflag=1];

(*Wires*)
Module[{wire1,wire2,wirec,spt,spc,ip1,ip2,hl1,hl2,con},
If[save$wire[[0]]===Symbol||save$wire==={},
mod$WriteStatus["No wires registered."];wire1={};wire2={};,

wire1=save$wire[[All,1]];wire2=save$wire[[All,3]];
Do[
If[wire1[[n]]==wire2[[n]],
mod$WriteError["Wire "<>save$wire[[n,13]]<>" attached to the same bodies."];
Abort[]],{n,Length[save$wire]}];

wirec=Table[save$wire[[n,14]]>0&&save$wire[[n,15]]>0,{n,Length[save$wire]}];
Do[
If[Not[wirec[[n]]],
mod$WriteError["Wire "<>save$wire[[n,13]]<>" has 0 or negative stiffness."];
Abort[]],{n,Length[save$wire]}];

];

(*Springs*)
If[save$vspr[[0]]===Symbol||save$vspr==={},
mod$WriteStatus["No vertical springs registered."],

Do[
If[save$vspr[[n,1]]>Length[save$wire],
mod$WriteError["Spring "<>save$vspr[[n,8]]<>" is not connected to a wire."];
Abort[]],{n,Length[save$vspr]}];

Do[
If[Not[save$vspr[[n,3]]>0],
mod$WriteError["Spring "<>save$vspr[[n,8]]<>" has 0 or negative stiffness."];
Abort[]],{n,Length[save$vspr]}];

spt=Tally[save$vspr[[All,8]]][[All,2]];
spc=Table[spt[[n]]==1,{n,Length[spt]}];
If[MemberQ[spc,False],
mod$WriteError["Duplicated spring names found."];calc$sflag=1];
];

(*IP*)
If[save$IP[[0]]===Symbol||save$IP==={},
mod$WriteStatus["No inverted pendulums registered."];ip1={};ip2={};,

ip1=save$IP[[All,1]];ip2=save$IP[[All,2]];
Do[
If[save$IP[[n,1]]==save$IP[[n,2]],
mod$WriteError["Iniverted pendulum "<>save$IP[[n,6]]<>" attached to the same bodies."];
calc$sflag=1],{n,Length[save$IP]}];
];

(* ***********************Version 1.1******************************** *)
(*IP Version 1.0 Compriance Check*)
Do[
If[Length[save$IP[[n,4]]]==3,AppendTo[save$IP[[n,4]],0]];
If[Length[save$IP[[n,5]]]==3,AppendTo[save$IP[[n,5]],1000]];
,{n,Length[save$IP]}];
(* ***********************Version 1.1******************************** *)

(*HL*)
If[save$HL[[0]]===Symbol||save$HL==={},
mod$WriteStatus["No heat links registered."];hl1={};hl2={};,

hl1=save$HL[[All,1]];hl2=save$HL[[All,2]];
Do[
If[save$HL[[n,1]]==save$HL[[n,2]],
mod$WriteError["Heat link "<>save$HL[[n,10]]<>" attached to the same bodies."];
calc$sflag=1],{n,Length[save$HL]}];
];

(*damper*)
If[save$damp[[0]]===Symbol||save$damp==={},
mod$WriteStatus["No dampers registered."],
Table[
If[save$damp[[n,2]]==save$damp[[n,3]],
mod$WriteError["Damper "<>save$damp[[n,1]]<>" affects to the same bodies."];
calc$sflag=1],{n,Length[save$damp]}];

con=Join[wire1,wire2,ip1,ip2,hl1,hl2];

(*Floating bodies check*)
Do[
If[Not[MemberQ[con,n]],
mod$WriteError["Body "<>save$bdn[[n,2]]<>" is floating."];
calc$sflag=1],{n,Length[save$bdn]}];

];

];

);

Setting

Set Variables

mod$SetVars:=
Module[{nlist,tv},
(*---State Variables---*)
tv={};
If[ValueQ[save$IP],nlist=Table[save$IP[[n,2]],{n,Length[save$IP]}],nlist={}];
Do[If[Not[save$bdn[[n,1]]],
If[MemberQ[nlist,n],
AppendTo[tv,ToExpression["x"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["z"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["yaw"<>save$bdn[[n,2]]]];,
AppendTo[tv,ToExpression["x"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["y"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["z"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["pitch"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["yaw"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["roll"<>save$bdn[[n,2]]]];]],
{n,Length[save$bdn]}];allvars=tv;
(*---Input Variables---*)
tv={};
Do[If[save$bdn[[n,1]],
AppendTo[tv,ToExpression["x"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["y"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["z"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["pitch"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["yaw"<>save$bdn[[n,2]]]];
AppendTo[tv,ToExpression["roll"<>save$bdn[[n,2]]]];],
{n,Length[save$bdn]}];allparams=tv;
(*---Float Variables---*)
tv={};
If[ValueQ[save$vspr],
Do[AppendTo[tv,ToExpression["h"<>save$vspr[[n,8]]]],
{n,Length[save$vspr]}]];allfloats=tv;
(*---Velocity---*)
velvars=makevel[allvars];
velparams=makevel[allparams];
velfloats=makevel[allfloats];
];

Set Init Value

mod$SetInitVal:=Module[{nlist},
subdefparams={};
Do[If[save$bdn[[n,1]],
AppendTo[subdefparams,makesub[bodylist[[n,1]],Join[save$initpos[[n]],{0,0,0}]]]
],{n,Length[save$bdn]}];
subdefparams=Flatten[subdefparams,1];
subinitvars={};
If[ValueQ[save$IP],nlist=Table[save$IP[[n,2]],{n,Length[save$IP]}]];
Do[If[Not[save$bdn[[n,1]]],
If[MemberQ[nlist,n],
AppendTo[subinitvars,makesub[{bodylist[[n,1,1]],bodylist[[n,1,3]],bodylist[[n,1,5]]},
{save$initpos[[n,1]],save$initpos[[n,3]],0}]],
AppendTo[subinitvars,makesub[bodylist[[n,1]],Join[save$initpos[[n]],{0,0,0}]]]
]
],{n,Length[save$bdn]}];
subinitvars=Flatten[subinitvars,1];
subinitfloats=If[Length[allfloats]==0,{},makesub[allfloats,Table[0,{Length[allfloats]}]]];
];

Set Body Position

mod$SetBodyPos:=Module[{nlist,logic},
(*---State Variables---*)
If[ValueQ[save$IP],
nlist=Table[save$IP[[n,2]],{n,Length[save$IP]}],nlist={}];
save$bodypos=Table[
If[MemberQ[nlist,n],
{ToExpression["x"<>save$bdn[[n,2]]],
ToExpression["y"<>save$bdn[[save$IP[[Position[nlist,n][[1,1]],1]],2]]]+
save$IP[[Position[nlist,n][[1,1]],7]],
ToExpression["z"<>save$bdn[[n,2]]],
ToExpression["pitch"<>save$bdn[[save$IP[[Position[nlist,n][[1,1]],1]],2]]],
ToExpression["yaw"<>save$bdn[[n,2]]],
ToExpression["roll"<>save$bdn[[save$IP[[Position[nlist,n][[1,1]],1]],2]]]},
{ToExpression["x"<>save$bdn[[n,2]]],
ToExpression["y"<>save$bdn[[n,2]]],
ToExpression["z"<>save$bdn[[n,2]]],
ToExpression["pitch"<>save$bdn[[n,2]]],
ToExpression["yaw"<>save$bdn[[n,2]]],
ToExpression["roll"<>save$bdn[[n,2]]]
}],
{n,Length[save$bdn]}];
];

Set List

mod$SetList:=Module[{nlist},
If[ValueQ[save$vspr],nlist=Table[save$vspr[[n,1]],{n,Length[save$vspr]}],nlist={}];
bodylist=Table[
{save$bodypos[[n]],
save$mass[[n,1]],
save$mass[[n,2]],
save$shape[[n,1]],
save$shape[[n,2]]},
{n,Length[save$bdn]}];
If[ValueQ[save$IP]&&Not[save$IP==={}],
Do[AppendTo[bodylist,
{Join[b2s[save$bodypos[[save$IP[[n,1]]]],{save$IP[[n,3,m,1]],0,save$IP[[n,3,m,2]]}],
{-(b2s[{save$bodypos[[save$IP[[n,1]],1]],0,save$bodypos[[save$IP[[n,1]],3]],
0,save$bodypos[[save$IP[[n,1]],5]],0},
{save$IP[[n,3,m,1]],0,save$IP[[n,3,m,2]]}]-
b2s[{save$bodypos[[save$IP[[n,2]],1]],0,save$bodypos[[save$IP[[n,2]],3]],
0,save$bodypos[[save$IP[[n,2]],5]],0},
{save$IP[[n,3,m,1]],0,save$IP[[n,3,m,2]]}])[[3]]/save$IP[[n,7]],0,
(b2s[{save$bodypos[[save$IP[[n,1]],1]],0,save$bodypos[[save$IP[[n,1]],3]],
0,save$bodypos[[save$IP[[n,1]],5]],0},
{save$IP[[n,3,m,1]],0,save$IP[[n,3,m,2]]}]-
b2s[{save$bodypos[[save$IP[[n,2]],1]],0,save$bodypos[[save$IP[[n,2]],3]],
0,save$bodypos[[save$IP[[n,2]],5]],0},
{save$IP[[n,3,m,1]],0,save$IP[[n,3,m,2]]}])[[1]]/save$IP[[n,7]]
}],
0,Table[0,{6},{6}],"DoubleCylinder[y]",{0.15,0.2,save$IP[[n,7]],0.2,0.15}
}
],{m,3},{n,Length[save$IP]}]
];
wirelist=
Table[{
save$bodypos[[save$wire[[n,1]]]],
save$wire[[n,2]]+
Sqrt[save$mat[[save$wire[[n,5]],3]]GPa*(N[Pi]*save$wire[[n,9]]^4/64)/save$wire[[n,10]]]*
save$wire[[n,11]]+
If[MemberQ[nlist,n],
If[save$vspr[[Position[nlist,n][[1,1]],2]]==1,
ToExpression["h"<>save$vspr[[Position[nlist,n][[1,1]],8]]]*
save$vspr[[Position[nlist,n][[1,1]],7]],{0,0,0}],{0,0,0}],
save$bodypos[[save$wire[[n,3]]]],
save$wire[[n,4]]+
Sqrt[save$mat[[save$wire[[n,5]],3]]GPa*(N[Pi]*save$wire[[n,9]]^4/64)/save$wire[[n,10]]]*
save$wire[[n,12]]+
If[MemberQ[nlist,n],
If[save$vspr[[Position[nlist,n][[1,1]],2]]==2,
ToExpression["h"<>save$vspr[[Position[nlist,n][[1,1]],8]]]*
save$vspr[[Position[nlist,n][[1,1]],7]]*(-1),{0,0,0}],{0,0,0}],
save$wire[[n,6]]-2*Sqrt[save$mat[[save$wire[[n,5]],3]]GPa*
(N[Pi]*save$wire[[n,9]]^4/64)/save$wire[[n,10]]],
save$wire[[n,14]],save$wire[[n,15]],
save$mat[[save$wire[[n,5]],5]]*10^(save$mat[[save$wire[[n,5]],6]]),
save$mat[[save$wire[[n,5]],5]]*10^(save$mat[[save$wire[[n,5]],6]])*
Sqrt[save$mat[[save$wire[[n,5]],3]]GPa*(N[Pi]*save$wire[[n,9]]^4/64)/save$wire[[n,10]]]/
save$wire[[n,6]](*/2*),
save$mat[[save$wire[[n,5]],5]]*10^(save$mat[[save$wire[[n,5]],6]])
},{n,Length[save$wire]}];
If[ValueQ[save$vspr]&&Not[save$vspr==={}],
Do[AppendTo[bodylist,
{
If[save$vspr[[n,2]]==1,
Join[b2s[wirelist[[save$vspr[[n,1]],1]],wirelist[[save$vspr[[n,1]],2]]],
wirelist[[save$vspr[[n,1]],1,4;;6]]]],
0,Table[0,{6},{6}],"Cylinder[y]",{0.1,0.03,0.0,0,0}
}
],{n,Length[save$vspr]}]
];
damperlist=If[save$damp[[0]]=!=List,{},Table[{save$bodypos[[save$damp[[n,2]]]],save$damp[[n,4]],
save$bodypos[[save$damp[[n,3]]]],save$damp[[n,5]],save$damp[[n,6]]},{n,Length[save$damp]}]];
];

Energy Calculation

Calculate Energy

mod$CalcEnergy:=Module[{},
e$kin=makekinetic[bodylist]+makekineticvspr[save$vspr]+makekineticIP[save$IP];
e$pot=makegravpot[bodylist]+makewirepot[wirelist]+maketorsionpot[wirelist]+
makevsprpot[save$vspr]+makeIPpot[save$IP];
e$potc=makegravpot[bodylist]+makewirepotc2[wirelist]+maketorsionpotc[wirelist]+
makevsprpotc[save$vspr]+makeIPpotc[save$IP]+makeHLpotc[save$HL];
e$damp=makedamping[damperlist];
];

Find Eq

Find Equilibrium

mod$FindEquilibrium:=(
e$pot0=e$pot/.subdefparams;
subminvars=FindMinimum[
e$pot0,
Join[comb[allvars,allvars/.subinitvars],
comb[allfloats,allfloats/.subinitfloats]],
Method->"Newton",
MaxIterations->100000
][[2]];);

Calc Matirces

mod$CalcMatrices:=(
mod$WriteStatus["Calculating Mass Matrix 'M'..."];
matMvv=makemat[e$kin,velvars,velvars];
matMpv=makemat[e$kin,velvars,velparams];
mod$WriteStatus["Calculating real part of Stiffness Matrix 'K'..."];
matKvv=makemat[e$pot,allvars,allvars];
matKpv=makemat[e$pot,allvars,allparams];
If[Length[allfloats]≥1,
matKfv=makemat[e$pot,allvars,allfloats];
matKfp=makemat[e$pot,allparams,allfloats];
matKff=makemat[e$pot,allfloats,allfloats];
matKvv+=-Chop[matKfv.Inverse[matKff].Transpose[matKfv]];
matKpv+=-Chop[matKfv.Inverse[matKff].Transpose[matKfp]];
];
mod$WriteStatus["Calculating complex Stiffness Matrix 'Kc'..."];
matKvvc=makemat[e$potc,allvars,allvars];
matKpvc=makemat[e$potc,allvars,allparams];
If[Length[allfloats]≥1,
matKfvc=makemat[e$potc,allvars,allfloats];
matKfpc=makemat[e$potc,allparams,allfloats];
matKffc=makemat[e$potc,allfloats,allfloats];
matKvvc+=-Chop[matKfvc.Inverse[matKffc].Transpose[matKfvc]];
matKpvc+=-Chop[matKfvc.Inverse[matKffc].Transpose[matKfpc]];
];
mod$WriteStatus["Calculating Damping Matrix 'G'..."];
matGvv=makemat[e$damp,velvars,velvars];
matGpv=makemat[e$damp,velvars,velparams];
);

Eigen calc

mod$EigenCalc:=(
eigen=Eigensystem[Inverse[matMvv].Re[matKvv]];
eigenf=Reverse[Sqrt[eigen[[1]]]/(2N[Pi])];
eigenv=Reverse[eigen[[2]]];
);

4. Frequency Domain Plot

Base

Plot Base Option

baseoptmag={
Frame->True,Joined->True,
BaseStyle->{FontSize->15,Bold},
FrameLabel->{None,"Magnitude"},
GridLinesStyle->Dashed,
GridLines->{Automatic,mygrids2},
ImageSize->480,AspectRatio->0.6};

baseoptphs={
Frame->True,Joined->True,
BaseStyle->{FontSize->15,Bold},
FrameLabel->{"Frequency [Hz]","Phase [deg]"},
GridLinesStyle->Dashed,
FrameTicks->{{{-180,-90,0,90,180},None},{Automatic,None}},
GridLines->{Automatic,{-180,-90,0,90,180}},
ImageSize->480,AspectRatio->0.2};

baseoptpsd={
Frame->True,Joined->True,
BaseStyle->{FontSize->15,Bold},
FrameLabel->{"Frequency [Hz]",Dynamic[amplabel]},
GridLinesStyle->Dashed,
GridLines->{Automatic,mygrids2},
ImageSize->480,AspectRatio->0.8};

Function

takemag[tf_List,show_List]:=
If[Length[tf]==0||Not[MemberQ[show,True]],{{{0.01,1},{100,1}}},
Table[{tf[[n,m,1]],Abs[tf[[n,m,2]]]},
{n,DeleteCases[Table[If[show[[l]],l,0],{l,Length[tf]}],0]},{m,Length[tf[[n]]]}]];
takephs[tf_List,show_List]:=
If[Length[tf]==0||Not[MemberQ[show,True]],{{{0.01,0},{100,0}}},
Table[{tf[[n,m,1]],Arg[tf[[n,m,2]]]*180/N[Pi]},
{n,DeleteCases[Table[If[show[[l]],l,0],{l,Length[tf]}],0]},{m,Length[tf[[n]]]}]];
takepsd[tf_List,show_List]:=
If[Length[tf]==0||Not[MemberQ[show,True]],{{{0.01,1},{100,1}}},
Table[If[show[[n]],{tf[[n,m,1]],tf[[n,m,2]]}],
{n,DeleteCases[Table[If[show[[l]],l,0],{l,Length[tf]}],0]},{m,Length[tf[[n]]]}]];

Calculate TFs

Calculation

mod$CalcFreqPlot:=(
mod$OpenStatus;
mod$WriteStatus["Set frequency list."];
If[fgridtype,
freq=makefreqlist[fmin,fmax,ngrid],
freq=Table[fmin+(n-1)(fmax-fmin)/(ngrid-1),{n,ngrid}]];
(*calc$xrange={fmin,fmax};*)
mod$WriteStatus["Load heat link stiffness."];
mod$LoadkHL;
Which[calc$tfk==1,mod$CalcTFf,calc$tfk==2,mod$CalcTFs,
calc$tfk==3,mod$CalcSN,calc$tfk==4,mod$CalcTN];
mod$WriteStatus["Calculation finished!!"];
mod$CloseStatus;
);

Load kHL

mod$LoadkHL:=Module[{data,kHL,int},
subkHL=Table[{},{Length[freq]}];
If[ValueQ[save$HL],
Do[
If[Not[save$HL[[n,9,m,l]]==""],
data=Import["HeatLink/"<>save$HL[[n,9,m,l]]<>".txt","Table"];
kHL=Table[{data[[n,1]],data[[n,2]]+I data[[n,3]]},{n,Length[data]}];
int=Interpolation[kHL];
Do[AppendTo[subkHL[[i]],ToExpression["kHL$"<>save$HL[[n,9,m,l]]]->int[freq[[i]]]],{i,Length[freq]}];
],{n,Length[save$HL]},{m,6},{l,6}]
]];

Set Seism

mod$SetSeism:=
CreateDialog[{
If[ValueQ[calc$seism]&&Length[calc$seism]==Length[allparams],
temp$seism=calc$seism,temp$seism=Table["",{Length[allparams]}]];
temp$sCB=Table[False,{Length[allparams]}];
TextCell[Style["Load Seismic Injection",
Bold,Italic,White],Background->RGBColor[0,0,0]],
Style["File Name:",Bold,Italic],
TableForm[{{
TableForm[
Table[{Checkbox[With[{n=n},Dynamic[temp$sCB[[n]]]]],
ToString[allparams[[n]]],InputField[With[{n=n},
Dynamic[temp$seism[[n]]]],String,FieldSize->{15.,1.},Enabled->False]
},{n,Length[allparams]}]
],
Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.txt",{"Seismic"},3][[n]],8],
Do[If[temp$sCB[[m]],temp$seism[[m]]=
StringDrop[StringDrop[FileNames["*.txt",{"Seismic"},3][[n]],8],-4];
temp$sCB[[m]]=False],{m,Length[allparams]}],
Appearance->"Frameless",Alignment->Left,ImageSize->150]],
{n,Length[FileNames["*.txt",{"Seismic"},3]]}],
2,2,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{320,300},AppearanceElements->None]]

}}],
TableForm[{{
Button[Style["Load",Bold,White],
DialogReturn[calc$seism=temp$seism],
Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],
Appearance->"FramedPalette",Background->GrayLevel[.8]]}}]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{600,500},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Load Seismic Injection"
];

Calc TFf

mod$CalcTFf:=Module[{tflist,name},
Do[
If[calc$tfFi[[n]]&&calc$tfFo[[m]],
name=ToString[allvars[[m]]]<>" / "<>subforce[ToString[allvars[[n]]]];
mod$WriteStatus["Calculating TF:"<>name<>" ..."];
tflist=tfcalcfFD1[allvars[[n]],allvars[[m]],freq,subkHL];
AppendTo[calc$tfplot,comb[freq,tflist]];
AppendTo[calc$tfname,name];
AppendTo[calc$tfsel,False];
AppendTo[calc$tfshow,True];
AppendTo[calc$tfline,{Thick}];
],{n,Length[allvars]},{m,Length[allvars]}];
calc$tfFi=Table[False,{Length[allvars]}];

If[calc$combif&&calc$combin[[0]]==List,
Do[
If[calc$tfFo[[m]],
name=ToString[allvars[[m]]]<>" / "<>subforce[ToString[calc$combin[[n]]]];
mod$WriteStatus["Calculating TF:"<>name<>" ..."];
tflist=tfcalcfFD1[calc$combin[[n]],allvars[[m]],freq,subkHL];
If[tflist=!=Null,
AppendTo[calc$tfplot,comb[freq,tflist]];
AppendTo[calc$tfname,name];
AppendTo[calc$tfsel,False];
AppendTo[calc$tfshow,True];
AppendTo[calc$tfline,{Thick}];];
],{n,Length[calc$combin]},{m,Length[allvars]}];
];
calc$combif=False;
calc$tfFo=Table[False,{Length[allvars]}];

];

Cacl TFs

mod$CalcTFs:=Module[{tflist,name},
Do[
If[calc$tfGi[[n]]&&calc$tfGo[[m]],
name=ToString[allvars[[m]]]<>"/"<>ToString[allparams[[n]]];
mod$WriteStatus["Calculating TF:"<>name<>" ..."];
tflist=tfcalcFD1[allparams[[n]],allvars[[m]],freq,subkHL];
AppendTo[calc$tfplot,comb[freq,tflist]];
AppendTo[calc$tfname,name];
AppendTo[calc$tfsel,False];
AppendTo[calc$tfshow,True];
AppendTo[calc$tfline,{Thick}];
],{n,Length[allparams]},{m,Length[allvars]}];
calc$tfGi=Table[False,{Length[allparams]}];
calc$tfGo=Table[False,{Length[allvars]}];
];

Calc Seism

mod$CalcSN:=Module[{tflist,name,data,int,seism,sn},
If[MemberQ[Table[calc$sni[[n]]&&calc$seism[[n]]=="",{n,Length[allparams]}],True],
Beep[];CreateDialog[{"Set seismic injection.",DefaultButton[]},WindowTitle->"Error"];,
Do[
If[calc$sni[[n]],
mod$WriteStatus["Loading seismic injection data: "<>calc$seism[[n]]<>" ..."];
data=Import["seismic/"<>calc$seism[[n]]<>".txt","Table"];
int=Interpolation[data];
seism=Table[int[freq[[n]]],{n,Length[freq]}];
(*AppendTo[calc$psdplot,comb[freq,seism]];
AppendTo[calc$psdname,"Seismic "<>ToString[allparams[[n]]]];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];*)
Do[
If[calc$sno[[m]],
name=ToString[allvars[[m]]]<>" from "<>ToString[allparams[[n]]];
mod$WriteStatus["Calculating seismic noise: "<>name<>" ..."];
tflist=tfcalcFD1[allparams[[n]],allvars[[m]],freq,subkHL];
sn=Table[seism[[n]]*Abs[tflist[[n]]],{n,Length[freq]}];
AppendTo[calc$psdplot,comb[freq,sn]];
AppendTo[calc$psdname,name];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];
],{m,Length[allvars]}];
],{n,Length[allparams]}];
calc$sni=Table[False,{Length[allparams]}];
calc$sno=Table[False,{Length[allvars]}];
]];

Calc Thermal noise

mod$CalcTN:=Module[{tflist,name,tn},
Do[
If[calc$tnb[[m]],
name=ToString[allvars[[m]]]<>" Thermal Noise "<>ToString[calc$tnT]<>" K";
mod$WriteStatus["Calculating thermal noise:"<>name<>" ..."];
tflist=tfcalcfFD1[allvars[[m]],allvars[[m]],freq,subkHL];
tn=Table[Sqrt[-4*kB*calc$tnT*Im[tflist[[n]]]/(2*N[Pi]*freq[[n]])],{n,Length[freq]}];
AppendTo[calc$psdplot,comb[freq,tn]];
AppendTo[calc$psdname,name];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];
],{m,Length[allvars]}];
calc$tnb=Table[False,{Length[allvars]}];
];

Add Seism Plot

mod$AddSeismPlot:=Module[{data,int,seism},
If[MemberQ[Table[calc$sni[[n]]&&calc$seism[[n]]=="",{n,Length[allparams]}],True],
Beep[];CreateDialog[{"Set seismic injection.",DefaultButton[]},WindowTitle->"Error"];,
If[fgridtype,
freq=makefreqlist[fmin,fmax,ngrid],
freq=Table[fmin+(n-1)(fmax-fmin)/(ngrid-1),{n,ngrid}]];
Do[
If[calc$sni[[n]],
mod$WriteStatus["Loading seismic injection data: "<>calc$seism[[n]]<>" ..."];
data=Import["seismic/"<>calc$seism[[n]]<>".txt","Table"];
int=Interpolation[data];
seism=Table[int[freq[[n]]],{n,Length[freq]}];
AppendTo[calc$psdplot,comb[freq,seism]];
AppendTo[calc$psdname,"Seismic "<>ToString[allparams[[n]]]];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];
],{n,Length[allparams]}];
calc$sni=Table[False,{Length[allparams]}];
]];

Manipulate Plots

Module SUM

mod$FPSum:=Module[{fr={},qfr,tf={},ncheck,name=""},
ncheck=If[calc$tfk≤ 2,
Sum[If[calc$tfsel[[n]],1,0],{n,Length[calc$tfplot]}],
Sum[If[calc$psdsel[[n]],1,0],{n,Length[calc$psdplot]}]];
If[ncheck≥2,
If[calc$tfk≤ 2,
Do[If[calc$tfsel[[np]],AppendTo[fr,Table[calc$tfplot[[np,n,1]],
{n,Length[calc$tfplot[[np]]]}]]],{np,Length[calc$tfplot]}],
Do[If[calc$psdsel[[np]],AppendTo[fr,Table[calc$psdplot[[np,n,1]],
{n,Length[calc$psdplot[[np]]]}]]],{np,Length[calc$psdplot]}]];
qfr=Flatten[Table[fr[[n]]==fr[[m]],{n,Length[fr]},{m,Length[fr]}],1];
If[Not[MemberQ[qfr,False]],
If[calc$tfk≤ 2,
tf=Table[Sum[If[calc$tfsel[[np]],calc$tfplot[[np,n,2]],0],
{np,Length[calc$tfplot]}],{n,Length[fr[[1]]]}];
Do[If[calc$tfsel[[np]],name=name<>" + "<>calc$tfname[[np]]],{np,Length[calc$tfplot]}],
tf=Table[Sqrt[Sum[If[calc$psdsel[[np]],calc$psdplot[[np,n,2]]^2,0],
{np,Length[calc$psdplot]}]],{n,Length[fr[[1]]]}];
Do[If[calc$psdsel[[np]],name=name<>" + "<>calc$psdname[[np]]],{np,Length[calc$psdplot]}]
];
If[calc$tfk≤ 2,
AppendTo[calc$tfplot,comb[fr[[1]],tf]];
AppendTo[calc$tfname,StringDrop[name,3]];
AppendTo[calc$tfsel,False];
AppendTo[calc$tfshow,True];
AppendTo[calc$tfline,{Thick}];
calc$tfsel=Table[False,{Length[calc$tfsel]}],
AppendTo[calc$psdplot,comb[fr[[1]],tf]];
AppendTo[calc$psdname,StringDrop[name,3]];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];
calc$psdsel=Table[False,{Length[calc$psdsel]}]
];
];
];
];

Module Factor

mod$FPFactor:=Module[{list},
If[calc$tfk≤ 2,
list=DeleteCases[Table[If[calc$tfsel[[l]],{l},0],{l,Length[calc$tfplot]}],0];
If[Length[list]≥1,
CreateDialog[{"Input a number to multiply",temp$tffact=1.;
InputField[Dynamic[temp$tffact],Number,FieldSize->{5.,1.}],
TableForm[{{
Button["OK",DialogReturn[If[NumberQ[temp$tffact],
Do[If[calc$tfsel[[n]],
AppendTo[calc$tfplot,comb[calc$tfplot[[n,All,1]],temp$tffact*calc$tfplot[[n,All,2]]]];
AppendTo[calc$tfname,ToString[temp$tffact]<>" times "<>calc$tfname[[n]]];
AppendTo[calc$tfsel,False];
AppendTo[calc$tfshow,True];
AppendTo[calc$tfline,{Thick}];
],{n,Length[calc$tfplot]}];
calc$tfsel=Table[False,{Length[calc$tfsel]}]
]]],
Button["Cancel",DialogReturn[]]}}]
},WindowTitle->"Constant Multiplier"]],

list=DeleteCases[Table[If[calc$psdsel[[l]],{l},0],{l,Length[calc$psdplot]}],0];
If[Length[list]≥1,
CreateDialog[{"Input a number to multiply",temp$tffact=1.;
InputField[Dynamic[temp$tffact],Number,FieldSize->{5.,1.}],
TableForm[{{
Button["OK",DialogReturn[If[NumberQ[temp$tffact],
Do[If[calc$psdsel[[n]],
AppendTo[calc$psdplot,comb[calc$psdplot[[n,All,1]],temp$tffact*calc$psdplot[[n,All,2]]]];
AppendTo[calc$psdname,ToString[temp$tffact]<>" times "<>calc$psdname[[n]]];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];
],{n,Length[calc$psdplot]}];
calc$psdsel=Table[False,{Length[calc$psdsel]}]
]]],
Button["Cancel",DialogReturn[]]}}]
},WindowTitle->"Constant Multiplier"]]
]
];

Module Delete

mod$FPDelete:=Module[{list},
If[calc$tfk≤ 2,
list=DeleteCases[Table[If[calc$tfsel[[l]],{l},0],{l,Length[calc$tfplot]}],0];
If[Length[list]≥1,
calc$tfplot=Delete[calc$tfplot,list];
calc$tfname=Delete[calc$tfname,list];
calc$tfsel=Delete[calc$tfsel,list];
calc$tfshow=Delete[calc$tfshow,list];
calc$tfline=Delete[calc$tfline,list];

],
list=DeleteCases[Table[If[calc$psdsel[[l]],{l},0],{l,Length[calc$psdplot]}],0];
If[Length[list]≥1,
calc$psdplot=Delete[calc$psdplot,list];
calc$psdname=Delete[calc$psdname,list];
calc$psdsel=Delete[calc$psdsel,list];
calc$psdshow=Delete[calc$psdshow,list];
calc$psdline=Delete[calc$psdline,list];
]
]
];

Module Multiply

mod$FPMultiply:=Module[{fr={},qfr,tf={},ncheck,name=""},
ncheck=If[calc$tfk≤ 2,
Sum[If[calc$tfsel[[n]],1,0],{n,Length[calc$tfplot]}],
Sum[If[calc$psdsel[[n]],1,0],{n,Length[calc$psdplot]}]];
If[ncheck≥2,
If[calc$tfk≤ 2,
Do[If[calc$tfsel[[np]],AppendTo[fr,Table[calc$tfplot[[np,n,1]],
{n,Length[calc$tfplot[[np]]]}]]],{np,Length[calc$tfplot]}],
Do[If[calc$psdsel[[np]],AppendTo[fr,Table[calc$psdplot[[np,n,1]],
{n,Length[calc$psdplot[[np]]]}]]],{np,Length[calc$psdplot]}]];
qfr=Flatten[Table[fr[[n]]==fr[[m]],{n,Length[fr]},{m,Length[fr]}],1];
If[Not[MemberQ[qfr,False]],
If[calc$tfk≤ 2,
tf=Table[Product[If[calc$tfsel[[np]],calc$tfplot[[np,n,2]],1],
{np,Length[calc$tfplot]}],{n,Length[fr[[1]]]}];
Do[If[calc$tfsel[[np]],name=name<>" * "<>calc$tfname[[np]]],{np,Length[calc$tfplot]}],
tf=Table[Product[If[calc$psdsel[[np]],calc$psdplot[[np,n,2]],1],
{np,Length[calc$psdplot]}],{n,Length[fr[[1]]]}];
Do[If[calc$psdsel[[np]],name=name<>" * "<>calc$psdname[[np]]],{np,Length[calc$psdplot]}]
];
If[calc$tfk≤ 2,
AppendTo[calc$tfplot,comb[fr[[1]],tf]];
AppendTo[calc$tfname,StringDrop[name,3]];
AppendTo[calc$tfsel,False];
AppendTo[calc$tfshow,True];
AppendTo[calc$tfline,{Thick}];
calc$tfsel=Table[False,{Length[calc$tfsel]}],
AppendTo[calc$psdplot,comb[fr[[1]],tf]];
AppendTo[calc$psdname,StringDrop[name,3]];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];
calc$psdsel=Table[False,{Length[calc$psdsel]}]
];
];
];
];

Module Inverse

mod$FPInverse:=Module[{list},
If[calc$tfk≤ 2,
list=DeleteCases[Table[If[calc$tfsel[[l]],{l},0],{l,Length[calc$tfplot]}],0];
If[Length[list]≥1,
Do[If[calc$tfsel[[n]],
AppendTo[calc$tfplot,comb[calc$tfplot[[n,All,1]],1/calc$tfplot[[n,All,2]]]];
AppendTo[calc$tfname,"Inverse "<>calc$tfname[[n]]];
AppendTo[calc$tfsel,False];
AppendTo[calc$tfshow,True];
AppendTo[calc$tfline,{Thick}];
],{n,Length[calc$tfplot]}];
calc$tfsel=Table[False,{Length[calc$tfsel]}]
],

list=DeleteCases[Table[If[calc$psdsel[[l]],{l},0],{l,Length[calc$psdplot]}],0];
If[Length[list]≥1,
Do[If[calc$psdsel[[n]],
AppendTo[calc$psdplot,comb[calc$psdplot[[n,All,1]],1/calc$psdplot[[n,All,2]]]];
AppendTo[calc$psdname,"Inverse "<>calc$psdname[[n]]];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];
],{n,Length[calc$psdplot]}];
calc$psdsel=Table[False,{Length[calc$psdsel]}]
]]
];

Module RMS

mod$FPRMS:=Module[{list,rms},
If[calc$tfk≥3,
list=DeleteCases[Table[If[calc$psdsel[[l]],{l},0],{l,Length[calc$psdplot]}],0];
If[Length[list]≥1,
Do[If[calc$psdsel[[n]],
rms=makerms[calc$psdplot[[n,All,2]],calc$psdplot[[n,All,1]]];
AppendTo[calc$psdplot,comb[calc$psdplot[[n,All,1]],rms]];
AppendTo[calc$psdname,"RMS "<>calc$psdname[[n]]];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];
],{n,Length[calc$psdplot]}];
calc$psdsel=Table[False,{Length[calc$psdsel]}]
]]
];

Module Hide

mod$FPHide:=Module[{list},
If[calc$tfk≤ 2,
list=DeleteCases[Table[If[calc$tfsel[[l]],{l},0],{l,Length[calc$tfplot]}],0];
If[Length[list]≥1,
Do[calc$tfsel[[n]]=False;calc$tfshow[[n]]=False,{n,list}]],
list=DeleteCases[Table[If[calc$psdsel[[l]],{l},0],{l,Length[calc$psdplot]}],0];
If[Length[list]≥1,
Do[calc$psdsel[[n]]=False;calc$psdshow[[n]]=False,{n,list}]]
]
];

Module Show

mod$FPShow:=Module[{list},
If[calc$tfk≤ 2,
list=DeleteCases[Table[If[calc$tfsel[[l]],{l},0],{l,Length[calc$tfplot]}],0];
If[Length[list]≥1,
Do[calc$tfsel[[n]]=False;calc$tfshow[[n]]=True,{n,list}]],
list=DeleteCases[Table[If[calc$psdsel[[l]],{l},0],{l,Length[calc$psdplot]}],0];
If[Length[list]≥1,
Do[calc$psdsel[[n]]=False;calc$psdshow[[n]]=True,{n,list}]]
]
];

Module Save

mod$FPSave:=Module[{list,ns},
sepchar=StringTake[FileNames["*.m",{"save"},3][[1]],{5}];
If[calc$tfk≤ 2,
list=DeleteCases[Table[If[calc$tfsel[[l]],l,0],{l,Length[calc$tfplot]}],0];
If[Length[list]==1,
ns=list[[1]];
CreateDialog[{
temp$tfsaveQ=False;temp$tfname=calc$tfname[[ns]];
TextCell[Style["Save Plot",
Bold,Italic,White],Background->RGBColor[0,0,0]],
TableForm[{
ListLogLogPlot[takemag[{calc$tfplot[[ns]]},{calc$tfshow[[ns]]}],
ImageSize->300,baseoptmag,PlotRange->Automatic],
ListLogLinearPlot[takephs[{calc$tfplot[[ns]]},{calc$tfshow[[ns]]}],
ImageSize->300,baseoptphs,PlotRange->{Automatic,{-180,180}}]
}],
Style["File Name:",Bold,Italic],
TableForm[{{InputField[Dynamic[temp$tfname],String,FieldSize->{20.,1.}],
Button[Style["Save",Bold,White],
If[MemberQ[FileNames["*.m",{"plot/tf"},3],"plot/tf"<>sepchar<>temp$tfname<>".m"],
temp$tfsaveQ=True,
savetf$plot=calc$tfplot[[ns]];savetf$name=calc$tfname[[ns]];
Save[Directory[]<>"/plot/tf"<>sepchar<>temp$tfname<>".m","savetf$*"];
DialogReturn[]],Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],Appearance->"FramedPalette",Background->GrayLevel[.8]]
}}],
Dynamic[PaneSelector[{True->
TableForm[{{Style["Do you really want to overwrite?",Red,Bold],
Button[Style["Yes",Bold,Small,White],
DialogReturn[
savetf$plot=calc$tfplot[[ns]];savetf$name=calc$tfname[[ns]];
DeleteFile[Directory[]<>"/plot/tf"<>sepchar<>temp$tfname<>".m"];
Save[Directory[]<>"/plot/tf"<>sepchar<>temp$tfname<>".m","savetf$*"]],
Appearance->"FramedPalette",Background->RGBColor[1,0,0]],
Button[Style["No",Bold,Small,Black],temp$tfsaveQ=False,
Appearance->"FramedPalette",Background->White]
}}],False->Null},temp$tfsaveQ,ImageSize->Automatic]],
Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.m",{"plot/tf"},3][[n]],8],
temp$tfname=StringDrop[StringDrop[FileNames["*.m",{"plot/tf"},3][[n]],8],-2],
Appearance->"Frameless",Alignment->Left,ImageSize->150]]
,{n,Length[FileNames["*.m",{"plot/tf"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{500,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{550,600},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Save Model"
]
],

list=DeleteCases[Table[If[calc$psdsel[[l]],l,0],{l,Length[calc$psdplot]}],0];
If[Length[list]==1,
ns=list[[1]];
CreateDialog[{
temp$tfsaveQ=False;temp$tfname=calc$psdname[[ns]];
TextCell[Style["Save Plot",
Bold,Italic,White],Background->RGBColor[0,0,0]],
ListLogLogPlot[takepsd[{calc$psdplot[[ns]]},{calc$psdshow[[ns]]}],
ImageSize->300,baseoptpsd,PlotRange->Automatic],
Style["File Name:",Bold,Italic],
TableForm[{{InputField[Dynamic[temp$tfname],String,FieldSize->{20.,1.}],
Button[Style["Save",Bold,White],
If[MemberQ[FileNames["*.m",{"plot/psd"},3],"plot/psd"<>sepchar<>temp$tfname<>".m"],
temp$tfsaveQ=True,
savetf$plot=calc$psdplot[[ns]];savetf$name=calc$psdname[[ns]];
Save[Directory[]<>"/plot/psd"<>sepchar<>temp$tfname<>".m","savetf$*"];
DialogReturn[]],Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],Appearance->"FramedPalette",Background->GrayLevel[.8]]
}}],
Dynamic[PaneSelector[{True->
TableForm[{{Style["Do you really want to overwrite?",Red,Bold],
Button[Style["Yes",Bold,Small,White],
DialogReturn[
savetf$plot=calc$psdplot[[ns]];savetf$name=calc$psdname[[ns]];
DeleteFile[Directory[]<>"/plot/psd"<>sepchar<>temp$tfname<>".m"];
Save[Directory[]<>"/plot/psd"<>sepchar<>temp$tfname<>".m","savetf$*"]],
Appearance->"FramedPalette",Background->RGBColor[1,0,0]],
Button[Style["No",Bold,Small,Black],temp$tfsaveQ=False,
Appearance->"FramedPalette",Background->White]
}}],False->Null},temp$tfsaveQ,ImageSize->Automatic]],
Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.m",{"plot/psd"},3][[n]],9],
temp$tfname=StringDrop[StringDrop[FileNames["*.m",{"plot/psd"},3][[n]],9],-2],
Appearance->"Frameless",Alignment->Left,ImageSize->150]]
,{n,Length[FileNames["*.m",{"plot/psd"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{500,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{550,600},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Save Model"
]
]
]
];

Module Load

mod$FPLoad:=Module[{list},
sepchar=StringTake[FileNames["*.m",{"save"},3][[1]],{5}];
If[calc$tfk≤ 2,

savetf$plot={{0.01,1},{100,1}};
CreateDialog[{
TextCell[Style["Load Plot",
Bold,Italic,White],Background->RGBColor[0,0,0]],
Dynamic[TableForm[{
ListLogLogPlot[takemag[{savetf$plot},{True}],
ImageSize->300,baseoptmag,PlotRange->Automatic],
ListLogLinearPlot[takephs[{savetf$plot},{True}],
ImageSize->300,baseoptphs,PlotRange->{Automatic,{-180,180}}]
}]],
Style["File Name:",Bold,Italic],

TableForm[{{InputField[Dynamic[temp$tfname],String,FieldSize->{20.,1.}],
Button[Style["Load",Bold,White],
AppendTo[calc$tfplot,savetf$plot];
AppendTo[calc$tfname,savetf$name];
AppendTo[calc$tfsel,False];
AppendTo[calc$tfshow,True];
AppendTo[calc$tfline,{Thick}];
DialogReturn[],Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],Appearance->"FramedPalette",Background->GrayLevel[.8]]
}}],

Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.m",{"plot/tf"},3][[n]],8],
temp$tfname=StringDrop[StringDrop[FileNames["*.m",{"plot/tf"},3][[n]],8],-2];
Get[Directory[]<>"/plot/tf"<>sepchar<>temp$tfname<>".m"],
Appearance->"Frameless",Alignment->Left,ImageSize->150]]
,{n,Length[FileNames["*.m",{"plot/tf"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{500,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{550,600},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Load Model"
],

savetf$plot={{0.01,1},{100,1}};
CreateDialog[{
TextCell[Style["Load Plot",
Bold,Italic,White],Background->RGBColor[0,0,0]],
Dynamic[ListLogLogPlot[takepsd[{savetf$plot},{True}],
ImageSize->300,baseoptpsd,PlotRange->Automatic]],
Style["File Name:",Bold,Italic],

TableForm[{{InputField[Dynamic[temp$tfname],String,FieldSize->{20.,1.}],
Button[Style["Load",Bold,White],
AppendTo[calc$psdplot,savetf$plot];
AppendTo[calc$psdname,savetf$name];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];
DialogReturn[],Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],Appearance->"FramedPalette",Background->GrayLevel[.8]]
}}],

Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.m",{"plot/psd"},3][[n]],9],
temp$tfname=StringDrop[StringDrop[FileNames["*.m",{"plot/psd"},3][[n]],9],-2];
Get[Directory[]<>"/plot/psd"<>sepchar<>temp$tfname<>".m"],
Appearance->"Frameless",Alignment->Left,ImageSize->150]]
,{n,Length[FileNames["*.m",{"plot/psd"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{500,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{550,600},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Load Model"
]
]
];

Module Export

mod$FPExport:=Module[{list,ns,tfd},
sepchar=StringTake[FileNames["*.m",{"save"},3][[1]],{5}];
If[calc$tfk≤ 2,
list=DeleteCases[Table[If[calc$tfsel[[l]],l,0],{l,Length[calc$tfplot]}],0];
If[Length[list]==1,

ns=list[[1]];
CreateDialog[{
temp$saveQ=False;temp$exname=calc$tfname[[ns]];
TextCell[Style["Export Plot Data",
Bold,Italic,White],Background->RGBColor[0,0,0]],
TableForm[{
ListLogLogPlot[takemag[{calc$tfplot[[ns]]},{calc$tfshow[[ns]]}],
ImageSize->300,baseoptmag,PlotRange->Automatic],
ListLogLinearPlot[takephs[{calc$tfplot[[ns]]},{calc$tfshow[[ns]]}],
ImageSize->300,baseoptphs,PlotRange->{Automatic,{-180,180}}]
}],

Style["File Name:",Bold,Italic],
TableForm[{{InputField[Dynamic[temp$exname],String,FieldSize->{30.,1.}],
Button[Style["Save",Bold,White],
If[MemberQ[FileNames["*.dat",{"plot/data"},3],"plot/data"<>sepchar<>temp$exname<>".dat"],
temp$saveQ=True,
tfd=calc$tfplot[[ns]];
export$tf=Table[{tfd[[n,1]],Abs[tfd[[n,2]]],Arg[tfd[[n,2]]]/deg},{n,Length[tfd]}];
Export[Directory[]<>"/plot/data"<>sepchar<>temp$exname<>".dat",export$tf,"Table"];
DialogReturn[]],Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],Appearance->"FramedPalette",Background->GrayLevel[.8]]
}}],

Dynamic[PaneSelector[{True->
TableForm[{{Style["Do you really want to overwrite?",Red,Bold],
Button[Style["Yes",Bold,Small,White],
DialogReturn[
DeleteFile[Directory[]<>"/plot/data"<>sepchar<>temp$exname<>".dat"];
tfd=calc$tfplot[[ns]];
export$tf=Table[{tfd[[n,1]],Abs[tfd[[n,2]]],Arg[tfd[[n,2]]]/deg},{n,Length[tfd]}];
Export[Directory[]<>"/plot/data"<>sepchar<>temp$exname<>".dat",export$tf,"Table"]],
Appearance->"FramedPalette",Background->RGBColor[1,0,0]],
Button[Style["No",Bold,Small,Black],temp$saveQ=False,
Appearance->"FramedPalette",Background->White]
}}],False->Null},temp$saveQ,ImageSize->Automatic]],
Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.dat",{"plot/data"},3][[n]],10],
temp$exname=StringDrop[StringDrop[FileNames["*.dat",{"plot/data"},3][[n]],10],-4],
Appearance->"Frameless",Alignment->Left,ImageSize->150]]
,{n,Length[FileNames["*.dat",{"plot/data"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{500,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{550,600},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Export Plot Data"
]
],

list=DeleteCases[Table[If[calc$psdsel[[l]],l,0],{l,Length[calc$psdplot]}],0];
If[Length[list]==1,
ns=list[[1]];
CreateDialog[{
temp$saveQ=False;temp$exname=calc$psdname[[ns]];
TextCell[Style["Export Plot Data",
Bold,Italic,White],Background->RGBColor[0,0,0]],
ListLogLogPlot[takepsd[{calc$psdplot[[ns]]},{calc$psdshow[[ns]]}],
ImageSize->300,baseoptpsd,PlotRange->Automatic],
Style["File Name:",Bold,Italic],
TableForm[{{InputField[Dynamic[temp$exname],String,FieldSize->{20.,1.}],
Button[Style["Save",Bold,White],
If[MemberQ[FileNames["*.dat",{"plot/data"},3],"plot/data"<>sepchar<>temp$tfname<>".dat"],
temp$saveQ=True,
Export[Directory[]<>"/plot/data"<>sepchar<>temp$exname<>".dat",calc$psdplot[[ns]],"Table"];
DialogReturn[]],Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],Appearance->"FramedPalette",Background->GrayLevel[.8]]
}}],
Dynamic[PaneSelector[{True->
TableForm[{{Style["Do you really want to overwrite?",Red,Bold],
Button[Style["Yes",Bold,Small,White],
DialogReturn[
DeleteFile[Directory[]<>"/plot/data"<>sepchar<>temp$exname<>".dat"];
Export[Directory[]<>"/plot/data"<>sepchar<>temp$exname<>".dat",calc$psdplot[[ns]],"Table"]],
Appearance->"FramedPalette",Background->RGBColor[1,0,0]],
Button[Style["No",Bold,Small,Black],temp$saveQ=False,
Appearance->"FramedPalette",Background->White]
}}],False->Null},temp$saveQ,ImageSize->Automatic]],
Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.dat",{"plot/data"},3][[n]],10],
temp$exname=StringDrop[StringDrop[FileNames["*.dat",{"plot/data"},3][[n]],10],-4],
Appearance->"Frameless",Alignment->Left,ImageSize->150]]
,{n,Length[FileNames["*.dat",{"plot/data"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{500,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{550,600},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Export Plot Data"
]
]
]
];

Module Import

mod$FPImport:=Module[{list},
sepchar=StringTake[FileNames["*.m",{"save"},3][[1]],{5}];
If[calc$tfk≤ 2,
Null,
savetf$plot={{0.01,1},{100,1}};
CreateDialog[{
TextCell[Style["Import Plot",
Bold,Italic,White],Background->RGBColor[0,0,0]],
Dynamic[ListLogLogPlot[takepsd[{savetf$plot},{True}],
ImageSize->300,baseoptpsd,PlotRange->Automatic]],
Style["File Name:",Bold,Italic],

TableForm[{{InputField[Dynamic[temp$tfname],String,FieldSize->{20.,1.}],
Button[Style["Load",Bold,White],
AppendTo[calc$psdplot,savetf$plot];
AppendTo[calc$psdname,temp$tfname];
AppendTo[calc$psdsel,False];
AppendTo[calc$psdshow,True];
AppendTo[calc$psdline,{Thick}];
DialogReturn[],Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],Appearance->"FramedPalette",Background->GrayLevel[.8]]
}}],

Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.dat",{"plot/data"},3][[n]],10],
temp$tfname=StringDrop[StringDrop[FileNames["*.dat",{"plot/data"},3][[n]],10],-4];
savetf$plot=Import[Directory[]<>"/plot/data"<>sepchar<>temp$tfname<>".dat"],
Appearance->"Frameless",Alignment->Left,ImageSize->150]]
,{n,Length[FileNames["*.dat",{"plot/data"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{500,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{550,600},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Import Plot"
]
]
];

Line Style

mod$FPLineStyle[n_]:=
CreateDialog[{
temp$lc={0,0,0};
temp$lt=2;
temp$ls=1;
TextCell[Style["Line Style Setting",
Bold,Italic,White],Background->RGBColor[0,0,0]],

TableForm[{{Style["Set RGB Color:",Bold],
InputField[Dynamic[temp$lc[[1]]],FieldSize->{3.,1.},Background->RGBColor[{1,.8,.8}]],
InputField[Dynamic[temp$lc[[2]]],FieldSize->{3.,1.},Background->RGBColor[{.8,1,.8}]],
InputField[Dynamic[temp$lc[[3]]],FieldSize->{3.,1.},Background->RGBColor[{.8,.8,1}]]
}}],
TableForm[{{
mod$CButton[{0,0,0}],
mod$CButton[{1,0,0}],
mod$CButton[{0,1,0}],
mod$CButton[{0,0,1}],
mod$CButton[{0,1,1}],
mod$CButton[{1,0,1}],
mod$CButton[{1,1,0}],
mod$CButton[{.5,0,0}],
mod$CButton[{0,.5,0}],
mod$CButton[{0,0,.5}]
}}],
TableForm[{{Style["Set Thickness:",Bold],
InputField[Dynamic[temp$lt],FieldSize->{3.,1.},Background->RGBColor[{1,1,1}]]
}}],
TableForm[{{Style["Line Style:",Bold],
PopupMenu[Dynamic[temp$ls],
{1->"Solid",2->"Dashed",3->"Dotdashed"}]
}}],
Dynamic[Graphics[Which[
temp$ls==1,
Style[Line[{{0,0},{1,1},{2,0},{3,1}}],
AbsoluteThickness[temp$lt],RGBColor[temp$lc]],
temp$ls==2,
Style[Line[{{0,0},{1,1},{2,0},{3,1}}],
AbsoluteThickness[temp$lt],RGBColor[temp$lc],Dashed],
temp$ls==3,
Style[Line[{{0,0},{1,1},{2,0},{3,1}}],
AbsoluteThickness[temp$lt],RGBColor[temp$lc],DotDashed]],ImageSize->200]],

TableForm[{{
Button[Style["OK",Bold],DialogReturn[(*Save Button*)
If[calc$tfk≤2,
Which[temp$ls==1,
calc$tfline[[n]]={RGBColor[temp$lc],AbsoluteThickness[temp$lt]},
temp$ls==2,
calc$tfline[[n]]={RGBColor[temp$lc],AbsoluteThickness[temp$lt],Dashed},
temp$ls==3,
calc$tfline[[n]]={RGBColor[temp$lc],AbsoluteThickness[temp$lt],DotDashed}],
Which[temp$ls==1,
calc$psdline[[n]]={RGBColor[temp$lc],AbsoluteThickness[temp$lt]},
temp$ls==2,
calc$psdline[[n]]={RGBColor[temp$lc],AbsoluteThickness[temp$lt],Dashed},
temp$ls==3,
calc$psdline[[n]]={RGBColor[temp$lc],AbsoluteThickness[temp$lt],DotDashed}]
]]],
Button["Cancel",DialogReturn[]]}}](*Cancel Button*)

},WindowSize->400,WindowTitle->"Line Style Setting"];

mod$CButton[c_List]:=Button["     ",temp$lc=c,Appearance->"FramedPalette",Background->RGBColor[c]];

5. Eigen Plot

eigen view

optp={ViewPoint->{Infinity,0,0},ViewVertical->{0,1,0}};
optr={ViewPoint->{0,0,Infinity},ViewVertical->{0,1,0}};
viewQ[s_]:=StringMatchQ[s,"x*"]||StringMatchQ[s,"r*"];

6. Export

Mathematica Export

Mathematica Export

mod$ExportModel:=
CreateDialog[{
temp$saveQ=False;temp$type=1;
sepchar=StringTake[FileNames["*.m",{"save"},3][[1]],{5}];
TextCell[Style["Export Suspension Model in Mathematica Format",
Bold,Italic,White],Background->RGBColor[0,0,0]],
Style["Saved Parameters:",Bold,Italic],
Grid[Partition[{"matKpvc","matKvvc","matMvv","matMpv","matGpv","matGvv","allvars","allparams"},6,6,1,{}],Background->White],
Style["Export Type:",Bold,Italic],
PopupMenu[Dynamic[temp$type],{1->"All",2->"Z,Pitch",3->"X,Roll",4->"Y",5->"Yaw"}],"",
Style["File Name:",Bold,Italic],
TableForm[{{InputField[Dynamic[temp$FileName],String,FieldSize->{20.,1.}],
Button[Style["Save",Bold,White],
If[Not[StringLength[temp$FileName]==0],
If[MemberQ[FileNames["*.m",{"matrix"},3],"matrix"<>sepchar<>temp$FileName<>".m"],
temp$saveQ=True,
Module[{nv,np,allvars2,allparams2,matKpvc2,matKvvc2,matMvv2,matMpv2,matGpv2,matGvv2},
Which[temp$type==1,nv=Table[n,{n,Length[allvars]}];np=Table[n,{n,Length[allparams]}];,
temp$type==2,nv=mod$TakeZPitch[allvars];np=mod$TakeZPitch[allparams];,
temp$type==3,nv=mod$TakeXRoll[allvars];np=mod$TakeXRoll[allparams];,
temp$type==4,nv=mod$TakeY[allvars];np=mod$TakeY[allparams];,
temp$type==5,nv=mod$TakeYaw[allvars];np=mod$TakeYaw[allparams];];
allvars2=allvars;allparams2=allparams;matMvv2=matMvv;matMpv2=matMpv;
matKvvc2=matKvvc;matKpvc2=matKpvc;matGvv2=matGvv;matGpv2=matGpv;
allvars=allvars2[[nv]];allparams=allparams2[[np]];
matKvvc=matKvvc2[[nv,nv]];matKpvc=matKpvc2[[nv,np]];
matMvv=matMvv2[[nv,nv]];matMpv=matMpv2[[nv,np]];
matGvv=matGvv2[[nv,nv]];matGpv=matGpv2[[nv,np]];
Save[Directory[]<>"/matrix"<>sepchar<>temp$FileName<>".m",
{"matKpvc","matKvvc","matMvv","matMpv","matGpv","matGvv","allvars","allparams"}];
allvars=allvars2;allparams=allparams2;matMvv=matMvv2;matMpv=matMpv2;
matKvvc=matKvvc2;matKpvc=matKpvc2;matGvv=matGvv2;matGpv=matGpv2;];
DialogReturn[]]],Appearance->"FramedPalette",Background->Black],
Button[Style["Cancel",Bold],DialogReturn[],Appearance->"FramedPalette",Background->GrayLevel[.8]]
}}],
Dynamic[PaneSelector[{True->
TableForm[{{Style["Do you really want to overwrite?",Red,Bold],
Button[Style["Yes",Bold,Small,White],
DialogReturn[
DeleteFile[Directory[]<>"/matrix"<>sepchar<>temp$FileName<>".m"];
Module[{nv,np,allvars2,allparams2,matKpvc2,matKvvc2,matMvv2,matMpv2,matGpv2,matGvv2},
Which[temp$type==1,nv=Table[n,{n,Length[allvars]}];np=Table[n,{n,Length[allparams]}];,
temp$type==2,nv=mod$TakeZPitch[allvars];np=mod$TakeZPitch[allparams];,
temp$type==3,nv=mod$TakeXRoll[allvars];np=mod$TakeXRoll[allparams];,
temp$type==4,nv=mod$TakeY[allvars];np=mod$TakeY[allparams];,
temp$type==5,nv=mod$TakeYaw[allvars];np=mod$TakeYaw[allparams];];
allvars2=allvars;allparams2=allparams;matMvv2=matMvv;matMpv2=matMpv;
matKvvc2=matKvvc;matKpvc2=matKpvc;matGvv2=matGvv;matGpv2=matGpv;
allvars=allvars2[[nv]];allparams=allparams2[[np]];
matKvvc=matKvvc2[[nv,nv]];matKpvc=matKpvc2[[nv,np]];
matMvv=matMvv2[[nv,nv]];matMpv=matMpv2[[nv,np]];
matGvv=matGvv2[[nv,nv]];matGpv=matGpv2[[nv,np]];
Save[Directory[]<>"/matrix"<>sepchar<>temp$FileName<>".m",
{"matKpvc","matKvvc","matMvv","matMpv","matGpv","matGvv","allvars","allparams"}];
allvars=allvars2;allparams=allparams2;matMvv=matMvv2;matMpv=matMpv2;
matKvvc=matKvvc2;matKpvc=matKpvc2;matGvv=matGvv2;matGpv=matGpv2;];],
Appearance->"FramedPalette",Background->RGBColor[1,0,0]],
Button[Style["No",Bold,Small,Black],temp$saveQ=False,
Appearance->"FramedPalette",Background->White]
}}],False->Null},temp$saveQ,ImageSize->Automatic]],
Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.m",{"matrix"},3][[n]],7],
temp$FileName=StringDrop[StringDrop[FileNames["*.m",{"matrix"},3][[n]],7],-2],
Appearance->"Frameless",Alignment->Left,ImageSize->200]]
,{n,Length[FileNames["*.m",{"matrix"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{650,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,500},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Export Model"
];

Take Part

mod$TakeZPitch[list_]:=Module[{v1,v2,vc,vex},
v1=Select[Table[ToString[list[[n]]],{n,Length[list]}],Characters[#][[1]]=="z"&];
v2=Select[Table[ToString[list[[n]]],{n,Length[list]}],Characters[#][[1]]=="p"&];
vc=Join[v1,v2];
vex=Table[ToExpression[vc[[n]]],{n,Length[vc]}];
Sort[Table[Position[list,vex[[n]]][[1,1]],{n,Length[vex]}]]
];

mod$TakeXRoll[list_]:=Module[{v1,v2,vc,vex},
v1=Select[Table[ToString[list[[n]]],{n,Length[list]}],Characters[#][[1]]=="x"&];
v2=Select[Table[ToString[list[[n]]],{n,Length[list]}],Characters[#][[1]]=="r"&];
vc=Join[v1,v2];
vex=Table[ToExpression[vc[[n]]],{n,Length[vc]}];
Sort[Table[Position[list,vex[[n]]][[1,1]],{n,Length[vex]}]]
];

mod$TakeY[list_]:=Module[{vc,vex},
vc=Select[Table[ToString[list[[n]]],{n,Length[list]}],Characters[#][[1]]=="y"&&Not[Characters[#][[2]]=="a"]&];
vex=Table[ToExpression[vc[[n]]],{n,Length[vc]}];
Sort[Table[Position[list,vex[[n]]][[1,1]],{n,Length[vex]}]]
];

mod$TakeYaw[list_]:=Module[{vc,vex},
vc=Select[Table[ToString[list[[n]]],{n,Length[list]}],Characters[#][[1;;2]]=={"y","a"}&];
vex=Table[ToExpression[vc[[n]]],{n,Length[vc]}];
Sort[Table[Position[list,vex[[n]]][[1,1]],{n,Length[vex]}]]
];

MATLAB Export

MATLAB Export

mod$MATLABExport:=
CreateDialog[{
temp$saveQ=False;temp$type=1;
If[ValueQ[save$viscous]&&Length[save$viscous]==Length[allvars],temp$viscous=save$viscous,temp$viscous=Table[1.,{Length[allvars]}]];
sepchar=StringTake[FileNames["*.m",{"save"},3][[1]],{5}];
TextCell[Style["Export ABCD Matrices in MATLAB Format",
Bold,Italic,White],Background->RGBColor[0,0,0]],
Style["Conversion Frequency [Hz] from Structure to Viscous Damping:",Bold,Italic],
Grid[Partition[
Table[TableForm[{ToExpression[allvars[[n]]],With[{n=n},
InputField[Dynamic[temp$viscous[[n]]],Number,FieldSize->{5.,1.}]]}],{n,Length[allvars]}]
,6,6,1,{}],Background->White],
Style["Export Type:",Bold,Italic],
PopupMenu[Dynamic[temp$type],{1->"All",2->"Z,Pitch",3->"X,Roll",4->"Y",5->"Yaw"}],"",
Style["File Name:",Bold,Italic],
TableForm[{{InputField[Dynamic[temp$FileName],String,FieldSize->{20.,1.}],
Button[Style["Save",Bold,White],
If[Not[StringLength[temp$FileName]==0],
If[MemberQ[FileNames["*.m",{"matlab"},3],"matlab"<>sepchar<>temp$FileName<>".m"],
temp$saveQ=True,mod$SaveMATLAB[temp$type];save$viscous=temp$viscous;
DialogReturn[]]],Appearance->"FramedPalette",Background->Black,Method->"Queued"],
Button[Style["Cancel",Bold],DialogReturn[],Appearance->"FramedPalette",Background->GrayLevel[.8]]
}}],
Dynamic[PaneSelector[{True->
TableForm[{{Style["Do you really want to overwrite?",Red,Bold],
Button[Style["Yes",Bold,Small,White],
DialogReturn[
DeleteFile[Directory[]<>"/matlab"<>sepchar<>temp$FileName<>".m"];
mod$SaveMATLAB[temp$type];
save$viscous=temp$viscous;],
Appearance->"FramedPalette",Background->RGBColor[1,0,0],Method->"Queued"],
Button[Style["No",Bold,Small,Black],temp$saveQ=False,
Appearance->"FramedPalette",Background->White]
}}],False->Null},temp$saveQ,ImageSize->Automatic]],
Dynamic[Pane[TableForm[Partition[Table[
With[{n=n},Button[StringDrop[FileNames["*.m",{"matlab"},3][[n]],7],
temp$FileName=StringDrop[StringDrop[FileNames["*.m",{"matlab"},3][[n]],7],-2],
Appearance->"Frameless",Alignment->Left,ImageSize->200]]
,{n,Length[FileNames["*.m",{"matlab"},3]]}],
3,3,1,{}],TableAlignments->Left],
Scrollbars->True,ImageSize->{650,200},AppearanceElements->None]]
},
WindowElements->{"VerticalScrollBar","HorizontalScrollBar","MagnificationPopUp"},
WindowSize->{700,500},WindowMargins->{{0,Automatic},{Automatic,0}},
WindowTitle->"Export Model"
];

Save

mod$SaveMATLAB[type_]:=Module[{nv,np,ssA,ssB,ssC,ssD,matFD,vars,params,viscous,Mvv,Mpv,Kvvc,Kpvc,Gvv,Gpv,input,output},
Which[type==1,nv=Table[n,{n,Length[allvars]}];np=Table[n,{n,Length[allparams]}];,
type==2,nv=mod$TakeZPitch[allvars];np=mod$TakeZPitch[allparams];,
type==3,nv=mod$TakeXRoll[allvars];np=mod$TakeXRoll[allparams];,
type==4,nv=mod$TakeY[allvars];np=mod$TakeY[allparams];,
type==5,nv=mod$TakeYaw[allvars];np=mod$TakeYaw[allparams];];

viscous=temp$viscous[[nv]];
vars=allvars[[nv]];params=allparams[[np]];
Mvv=matMvv[[nv,nv]];Mpv=matMpv[[nv,np]];
Gvv=matGvv[[nv,nv]];Gpv=matGpv[[nv,np]];
Kvvc=matKvvc[[nv,nv]];Kpvc=matKpvc[[nv,np]];

matFD=DiagonalMatrix[Table[1/2/N[Pi]/viscous[[n]],{n,Length[vars]}]];

ssA=
ArrayFlatten[
{
{
Table[0,{Length[params]},{Length[params]}],
IdentityMatrix[Length[params]],
Table[0,{Length[params]},{Length[vars]}],
Table[0,{Length[params]},{Length[vars]}]
},
{
Table[0,{Length[params]},{Length[params]}],
Table[0,{Length[params]},{Length[params]}],
Table[0,{Length[params]},{Length[vars]}],
Table[0,{Length[params]},{Length[vars]}]
},
{
Table[0,{Length[vars]},{Length[params]}],
Table[0,{Length[vars]},{Length[params]}],
Table[0,{Length[vars]},{Length[vars]}],
IdentityMatrix[Length[vars]]
},
{
-Inverse[Mvv].Re[Kpvc],
-Inverse[Mvv].Gpv,
-Inverse[Mvv].Re[Kvvc],
-Inverse[Mvv].Gvv-Inverse[Mvv].Im[Kvvc].matFD
}
}
];

ssB=
ArrayFlatten[
{
{
Table[0,{Length[params]},{Length[params]}],
Table[0,{Length[params]},{Length[vars]}]
},
{
IdentityMatrix[Length[params]],
Table[0,{Length[params]},{Length[vars]}]
},
{
Table[0,{Length[vars]},{Length[params]}],
Table[0,{Length[vars]},{Length[vars]}]
},
{
-Inverse[Mvv].Mpv,
Inverse[Mvv]
}
}
];

ssC=IdentityMatrix[2*(Length[params]+Length[vars])];

ssD=Table[0,{2*(Length[params]+Length[vars])},{Length[params]+Length[vars]}];

input=Join[
Table["a"<>ToString[params[[n]]],{n,Length[params]}],
Table["F"<>ToString[vars[[n]]],{n,Length[vars]}]
];

output=Join[
Table[ToString[params[[n]]],{n,Length[params]}],
Table["v"<>ToString[params[[n]]],{n,Length[params]}],
Table[ToString[vars[[n]]],{n,Length[vars]}],
Table["v"<>ToString[vars[[n]]],{n,Length[vars]}]
];

matlabexport[Directory[]<>"/matlab"<>sepchar<>temp$FileName<>".m",
{"ssA",ssA},{"ssB",ssB},{"ssC",ssC},{"ssD",ssD},{"varinput",input},{"varoutput",output}]

];