Project 1- Building a Master TCL/TK Macro
OBJECTIVE:
- Build a master tcl/tk macro
- It should contain buttons that will call all utilities created as assignments during this course
- Segregate the buttons as per their utility. Color code the buttons as you see fit.
- Display labels that indicate an idea of your segregation
- The design must look ergonomic and clutter free
- Test all the buttons thoroughly on am empty file too.
- Make sure that there are no null cases
CODE:
proc m_wind {} {
set M .window
catch {destroy $M}
toplevel $M -class toplevel
wm title $M "week 13"
wm geometry $M 390x350+200+200
wm deiconify $M
button $M.01 -text "ELEMENT QUALITY CHECK" -command "ele_qua_chk" -bg yellow -font {times 10 bold}; place $M.01 -x 20 -y 10 -width 350 -height 30
button $M.02 -text "MIDLINE & SPOTWELD" -command "mid_spot" -bg yellow -font {times 10 bold}; place $M.02 -x 20 -y 50 -width 350 -height 30
button $M.03 -text "WELDS & XYZ LOCATOR & MATCHING_SURFACES" -command "loc_cre_ent_r_match" -bg yellow -font {times 10 bold}; place $M.03 -x 20 -y 90 -width 350 -height 30
button $M.05 -text "CREATE COMPONENT AND ASIGN THICKNESS" -command "cp_at" -bg yellow -font {times 10 bold}; place $M.05 -x 20 -y 130 -width 350 -height 30
button $M.06 -text "REFLECT ENTITIES" -command "reflect_entities" -bg yellow -font {times 10 bold}; place $M.06 -x 20 -y 170 -width 350 -height 30
button $M.07 -text "Free-Edges & T-Edges Fix" -command "edges_f_T" -bg yellow -font {times 10 bold}; place $M.07 -x 20 -y 210 -width 350 -height 30
button $M.08 -text "RENUMBER/REORDER/MODIFY ENTITIES" -command "create_entities_re_rn" -bg yellow -font {times 10 bold}; place $M.08 -x 20 -y 250 -width 350 -height 30
button $M.c -text "EXIT" -command "destroy $M" -bg RED -font {times 12 bold}; place $M.c -x 90 -y 290 -width 200 -height 35
proc ele_qua_chk {} {
*createmark elems 1 "displayed"
if {[hm_marklength elems 1]!=0} {
*clearmarkall 1;
*clearmarkall 2;
set a .window
catch {destroy $a}
toplevel $a -class TopLevel
wm title $a "Element Quality Check"
wm geometry $a 300x550+1000+100; update
wm resizable $a 0 0
wm deiconify $a
#labels
label $a.01 -text "2D ELEMENTS QUALITY CHECK" -bg yellow -font {times 10 bold}; place $a.01 -x 0 -y 0 -width 300 -height 20
label $a.02 -text "3D ELEMENTS QUALITY CHECK" -bg yellow -font {times 10 bold}; place $a.02 -x 0 -y 340 -width 300 -height 20
label $a.03 -text "ELEMENTS QUALITY CHECK" -bg yellow -font {times 12 bold}; place $a.03 -x 0 -y 500 -width 300 -height 50
#buttons
button $a.11 -text "Min Length" -command {min_leng $min_l} -bg grey -font {times 10 bold}; place $a.11 -x 25 -y 30 -width 100 -height 20
button $a.12 -text "Max Length" -command {max_leng $max_l} -bg grey -font {times 10 bold}; place $a.12 -x 25 -y 60 -width 100 -height 20
button $a.13 -text "Warpage" -command {warpage $w} -bg grey -font {times 10 bold}; place $a.13 -x 25 -y 90 -width 100 -height 20
button $a.14 -text "Skew" -command {skew $s} -bg grey -font {times 10 bold}; place $a.14 -x 25 -y 120 -width 100 -height 20
button $a.15 -text "Aspect" -command {aspect $asp} -bg grey -font {times 10 bold}; place $a.15 -x 25 -y 150 -width 100 -height 20
button $a.16 -text "Jacobian" -command {jacobian $j} -bg grey -font {times 10 bold}; place $a.16 -x 25 -y 180 -width 100 -height 20
button $a.17 -text "Min Quad Angle" -command {min_quad_angle $min_qa_ang} -bg grey -font {times 10 bold}; place $a.17 -x 25 -y 210 -width 100 -height 20
button $a.18 -text "Max Quad Angle" -command {max_quad_angle $max_qa_ang} -bg grey -font {times 10 bold}; place $a.18 -x 25 -y 240 -width 100 -height 20
button $a.19 -text "Min tria Angle" -command {min_tria_angle $min_ta_ang} -bg grey -font {times 10 bold}; place $a.19 -x 25 -y 270 -width 100 -height 20
button $a.101 -text "Max tria Angle" -command {max_tria_angle $max_ta_ang} -bg grey -font {times 10 bold}; place $a.101 -x 25 -y 300 -width 100 -height 20
button $a.102 -text "Warpage" -command {warpage_3d $warp} -bg grey -font {times 10 bold}; place $a.102 -x 25 -y 370 -width 100 -height 20
button $a.103 -text "Tetra Collapse" -command {tetcollapse $tet} -bg grey -font {times 10 bold}; place $a.103 -x 25 -y 400 -width 100 -height 20
button $a.104 -text "Volume Skew " -command {vskew $v_skew} -bg grey -font {times 10 bold}; place $a.104 -x 25 -y 430 -width 100 -height 20
button $a.105 -text "Clear Nodes" -command {clear} -bg blue -font {times 10 bold}; place $a.105 -x 20 -y 470 -width 100 -height 20
button $a.106 -text "BACK" -command "destroy $a; m_wind;" -bg red -font {times 12 bold}; place $a.106 -x 150 -y 470 -width 100 -height 20
#textfields
entry $a.21 -textvariable min_l -bg white -font {times 10}; place $a.21 -x 165 -y 30 -width 100 -height 20
entry $a.22 -textvariable max_l -bg white -font {times 10}; place $a.22 -x 165 -y 60 -width 100 -height 20
entry $a.23 -textvariable w -bg white -font {times 10}; place $a.23 -x 165 -y 90 -width 100 -height 20
entry $a.24 -textvariable s -bg white -font {times 10}; place $a.24 -x 165 -y 120 -width 100 -height 20
entry $a.25 -textvariable asp -bg white -font {times 10}; place $a.25 -x 165 -y 150 -width 100 -height 20
entry $a.26 -textvariable j -bg white -font {times 10}; place $a.26 -x 165 -y 180 -width 100 -height 20
entry $a.27 -textvariable min_qa_ang -bg white -font {times 10}; place $a.27 -x 165 -y 210 -width 100 -height 20
entry $a.28 -textvariable max_qa_ang -bg white -font {times 10}; place $a.28 -x 165 -y 240 -width 100 -height 20
entry $a.29 -textvariable min_ta_ang -bg white -font {times 10}; place $a.29 -x 165 -y 270 -width 100 -height 20
entry $a.201 -textvariable max_ta_ang -bg white -font {times 10}; place $a.201 -x 165 -y 300 -width 100 -height 20
entry $a.202 -textvariable warp -bg white -font {times 10}; place $a.202 -x 165 -y 370 -width 100 -height 20
entry $a.203 -textvariable tet -bg white -font {times 10}; place $a.203 -x 165 -y 400 -width 100 -height 20
entry $a.204 -textvariable v_skew -bg white -font {times 10}; place $a.204 -x 165 -y 430 -width 100 -height 20
proc min_leng {min_l} {
if {$min_l==""} {tk_messageBox -message "Enter the minimum length and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestlength elements 1 $min_l 2 1 2 0 " 2D Min Length "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc max_leng {max_l} {
if {$max_l==""} {tk_messageBox -message "Enter the maximum length and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestlength elements 1 $max_l 2 0 2 0 " 2D Max Length "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc warpage {w} {
if {$w==""} {tk_messageBox -message "Enter the warpage and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestwarpage elements 1 $w 2 2 0 " 2D Warpage "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc skew {s} {
if {$s==""} {tk_messageBox -message "Enter the skewness and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*nodecleartempmark
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestskew elements 1 $s 2 2 0 " 2D Skew "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc aspect {asp} {
if {$asp==""} {tk_messageBox -message "Enter the 2D Aspect Ratio and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestaspect elements 1 $asp 2 2 0 " 2D Aspect Ratio "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc jacobian {j} {
if {$j==""} {tk_messageBox -message "Enter the 2D Jacobian and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestjacobian elements 1 $j 2 2 0 " 2D Jacobian "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc min_quad_angle {min_qa_ang} {
if {$min_qa_ang==""} {tk_messageBox -message "Enter the 2D Quad Min Angle and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestinterangle elements 1 $min_qa_ang 0 2 1 2 0 " 2D Quad Min Angle "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc max_quad_angle {max_qa_ang} {
if {$max_qa_ang==""} {tk_messageBox -message "Enter the 2D Quad Max Angle and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestinterangle elements 1 $max_qa_ang 0 2 0 2 0 " 2D Quad Max Angle "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc min_tria_angle {min_ta_ang} {
if {$min_ta_ang==""} {tk_messageBox -message "Enter the 2D Tria Min Angle and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestinterangle elements 1 $min_ta_ang 1 2 1 2 0 " 2D Tria Min Angle "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc max_tria_angle {max_ta_ang} {
if {$max_ta_ang==""} {tk_messageBox -message "Enter the 2D Tria Max Angle and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestinterangle elements 1 $max_ta_ang 1 2 0 2 0 " 2D Tria Max Angle "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc warpage_3d {warp} {
if {$warp==""} {tk_messageBox -message "Enter the 3D warpage and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestwarpage elements 1 $warp 2 4 0 " 3D Warpage "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc tetcollapse {tet} {
if {$tet==""} {tk_messageBox -message "Enter the 3D Tetra collapse and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtesttetracollapse elements 1 $tet 2 0 " 3D Tetra Collapse "
*maskentitymark elements 2 0
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc vskew {v_skew} {
if {$v_skew==""} {tk_messageBox -message "Enter the 3D skewness and click again!" -icon warning -type ok -title Message
} else {
*nodecleartempmark
*createmark elements 1 "displayed"
*elementtestvolumetricskew elements 1 $v_skew 2 0 " 3D Volumetric Skew "
*maskreverse elements
*createmark nodes 1 "displayed"
*nodemarkaddtempmark 1
*unmaskall2
}
}
proc clear {} {
*nodecleartempmark
}
} else {tk_messageBox -message "There are no displayed elements" -icon warning -type ok -title Message}
}
#END OF ELEMENT QUALITY CHECK
proc mid_spot {} {
set b .window
catch {destroy $b}
toplevel $b -class Toplevel
wm title $b "MIDLINE & SPOT WELD"
wm geometry $b 300x250+100+100
wm resizable $b 0 0
wm deiconify $b
button $b.1 -text "MIDLINE" -command {A} -bg yellow -font {times 10 bold}; place $b.1 -x 70 -y 20 -width 150 -height 40
button $b.2 -text "SPOT WELD" -command {B} -bg yellow -font {times 10 bold}; place $b.2 -x 70 -y 80 -width 150 -height 40
button $b.3 -text "BACK" -command "destroy $b; m_wind;" -bg red -font {times 12 bold}; place $b.3 -x 70 -y 130 -width 150 -height 40
proc B {} {
*clearmarkall 1
*createlistbypathpanel nodes 1 "Select the source nodes by path"
set source [hm_getlist nodes 1]
*createlistbypathpanel nodes 2 "Select the target nodes by path"
set target [hm_getlist nodes 2]
if {[hm_getlist nodes 1]!=0 && [hm_getlist nodes 2]!=0} {
foreach i $source j $target {
*elementtype 5 1
*rigid $i $j 123456
}
} else {tk_messageBox -message "No node selected" -icon warning -type ok -title Message}
}
proc A {} {
# *createentity comps name={Midline_$i}
*createlistbypathpanel lines 1 "Select the source lines by path"
set source [hm_getlist lines 1]
*createlistbypathpanel lines 2 "Select the target lines by path"
set target [hm_getlist lines 2]
if {[hm_getlist lines 1]!=0 && [hm_getlist lines 2]!=0} {
foreach i $source j $target {
*linescreatemidline 1 1 2 2
*linecombine $i $j 1
}
} else {tk_messageBox -message "No lines selected" -icon warning -type ok -title Message}
}
}
#END OF midline and spotweld
proc loc_cre_ent_r_match {} {
set c .window
catch {destroy $c}
toplevel $c -class toplevel
wm title $c "XYZ locator/match_surf"
wm geometry $c 230x420+200+200
#PART 1
button $c.01 -text "Create Components" -command "Create_Components" -bg yellow -font {times 12 bold}; place $c.01 -x 20 -y 30 -width 180 -height 30
button $c.02 -text "WELDS" -command "Create_weld" -bg yellow -font {times 12 bold}; place $c.02 -x 20 -y 70 -width 180 -height 30
button $c.03 -text "X-LOCATOR" -command "xlocator" -bg yellow -font {times 12 bold}; place $c.03 -x 20 -y 110 -width 180 -height 30
button $c.04 -text "Y-LOCATOR" -command "ylocator" -bg yellow -font {times 12 bold}; place $c.04 -x 20 -y 150 -width 180 -height 30
button $c.05 -text "Z-LOCATOR" -command "zlocator" -bg yellow -font {times 12 bold}; place $c.05 -x 20 -y 190 -width 180 -height 30
button $c.08 -text "BACK" -command "destroy $c; m_wind;" -bg red -font {times 12 bold}; place $c.08 -x 20 -y 310 -width 180 -height 40
proc Create_Components {} {
if {[hm_entityinfo exist comps "Welds"] ==0} {*createentity comps name=Welds}
if {[hm_entityinfo exist comps "X_LOCATOR"] ==0} { *createentity comps name=X_LOCATOR}
if {[hm_entityinfo exist comps "Y_LOCATOR"] ==0} { *createentity comps name=Y_LOCATOR}
if {[hm_entityinfo exist comps "Z_LOCATOR"] ==0} { *createentity comps name=Z_LOCATOR}
}
proc Create_weld {} {
*clearmarkall 1;
*currentcollector comps "Welds"
*createmarkpanel nodes 1 "Select Nodes"
*rigidlinkinodecalandcreate 1 0 0 123456
}
proc xlocator {} {
*clearmarkall 1;
*clearmarkall 2;
*currentcollector components "X_LOCATOR"
*createmarkpanel nodes 1 "Select First Node"
set s [hm_getmark nodes 1]
*createmarkpanel nodes 2 "Select Second Node"
set t [hm_getmark nodes 2]
*rigid $s $t 156
}
proc ylocator {} {
*clearmarkall 1;
*clearmarkall 2;
*currentcollector components "Y_LOCATOR"
*createmarkpanel nodes 1 "Select First Node"
set s [hm_getmark nodes 1]
*createmarkpanel nodes 2 "Select Second Node"
set t [hm_getmark nodes 2]
*rigid $s $t 246
}
proc zlocator {} {
*clearmarkall 1;
*clearmarkall 2;
*currentcollector components "Z_LOCATOR"
*createmarkpanel nodes 1 "Select First Node"
set s [hm_getmark nodes 1]
*createmarkpanel nodes 2 "Select Second Node"
set t [hm_getmark nodes 2]
*rigid $s $t 345
}
#PART 2
button $c.06 -text "READ NODE (.csv)" -command "read_n_data" -bg orange -font {times 12 bold}; place $c.06 -x 20 -y 230 -width 180 -height 30
proc read_n_data {} {
set fileChannelid [open [tk_getOpenFile -title "Select File"] r];
while {[eof $fileChannelid]==0} {
set n_row [gets $fileChannelid row]
if {$n_row > 0} {
set xyz [split $row ,];
set x [lindex $xyz 0]
set y [lindex $xyz 1]
set z [lindex $xyz 2]
*createnode $x $y $z
*createmark nodes 1 -1
set n_id [hm_getmark nodes 1]
*tagcreate nodes $n_id "$n_id"
}
}
close $fileChannelid;
}
#PART 3
button $c.07 -text "MATCH" -command "match" -bg blue -font {times 12 bold}; place $c.07 -x 20 -y 270 -width 180 -height 30
proc match {} {
*clearmarkall 1; *clearmarkall 2
*createmark comps 1 "all"
set a11_comp [hm_getmark comps 1];
foreach i $a11_comp {
*createmark surfaces 1 "by co11ector" $i
lappend a11_comp_surf [hm_marklength surfaces 1]
}
*createmarkpanel comps 2 "Select the geometric component of interest"
set target_comp [hm_getmark comp 2]
*isolateentitybymark 2
puts "Target comp id $target_comp"
*createmark surfaces 2 "by collector" $target_comp
puts [set target_comp_surf [hm_marklength surfaces 2]]
set match_list_surf [lsearch -all $a11_comp_surf $target_comp_surf]
puts "Match list surface $match_list_surf"
foreach j $match_list_surf {
set compid [lindex $a11_comp $j]
set comp_name [hm_entityinfo name comps $compid]
*displaycollectorwithfilter comps "on" "$comp_name" 0 1
}
}
}
#END OF XYZ LOCATOR/MATCHING SURFACES
proc cp_at {} {
set d .window
catch {destroy $d}
toplevel $d -class Toplevel
wm title $d "COMPONENT CREATION"
wm geometry $d 300x250+100+100
wm resizable $d 0 0
wm deiconify $d
label $d.label1 -text "Component" -bg grey -font {times 12 bold}; place $d.label1 -x 25 -y 20 -width 100 -height 30
label $d.label2 -text "Thickness" -bg grey -font {times 12 bold}; place $d.label2 -x 25 -y 70 -width 100 -height 30
entry $d.entry1 -width 5 -textvariable n ; place $d.entry1 -x 150 -y 20 -width 100 -height 30
entry $d.entry2 -width 5 -textvariable t ; place $d.entry2 -x 150 -y 70 -width 100 -height 30
button $d.1 -text "CREATE COMPONENT" -command {cre_com $s $n $t} -bg yellow -font {times 10 bold}; place $d.1 -x 70 -y 120 -width 150 -height 40
button $d.2 -text "BACK" -command "destroy $d; m_wind;" -bg red -font {times 12 bold}; place $d.2 -x 70 -y 170 -width 150 -height 40
#set s [hm_info templatetype] does not recognise optistruct solver
set s [hm_getsolver]
set i 1
proc cre_com {s n t} {
if {$n=="" || $t==""} { tk_messageBox -message "Please enter component name and thickness." -icon info -type ok
} else { if {$s =="optistruct"} {puts $s;optistruct_sol $n $t
} elseif {$s =="radioss"} { rad_sol $n $t
} else {tk_messageBox -message "Solver not available in the student version." -icon info -type ok}
}
}
proc optistruct_sol {n t} {
*createmark comps 1 $n
if {[hm_entityinfo exist comps $n]!=0} {
tk_messageBox -message "Already exists." -icon info -type ok
} else {
*createentity comps cardimage=Part includeid=0 name=$n
*createmark comps 1 $n
set n_id [hm_getmark comps 1]
*createentity props cardimage=PSHELL includeid=0 name=$n
*createmark props 2 $n
set prop_id [hm_getmark props 2]
*setvalue props id=$prop_id STATUS=1 95=$t
*setvalue comps id=$n_id propertyid={props $prop_id}
*createmark comps 1 "all"
*autocolorwithmark properties 1
}
}
proc nastran_sol {n t} {
*createmark comps 1 $n
if {[hm_entityinfo exist comps $n]!=0} {
tk_messageBox -message "Already exists." -icon info -type ok
} else {
*createentity comps cardimage=Part includeid=0 name=$n
*createmark comps 1 $n
set n_id [hm_getmark comps 1]
*createentity props cardimage=P1_SHELL includeid=0 name=$n
*createmark props 2 $n
set prop_id [hm_getmark props 2]
*setvalue props id=$prop_id 111=$t
*setvalue comps id=$n_id propertyid={props $prop_id}
*createmark comps 1 "all"
*autocolorwithmark properties 1
}
}
proc rad_sol {n t} {
*createmark comps 1 $n
if {[hm_entityinfo exist comps $n]!=0} {
tk_messageBox -message "Already exists." -icon info -type ok
} else {
*createentity comps cardimage=Part includeid=0 name=$n
*createmark comps 1 $n
set n_id [hm_getmark comps 1]
*createentity props cardimage=P1_SHELL includeid=0 name=$n
*createmark props 2 $n
set prop_id [hm_getmark props 2]
*setvalue props id=$prop_id STATUS=1 431=$t
*setvalue comps id=$n_id propertyid={props $prop_id}
*createmark comps 1 "all"
*autocolorwithmark properties 1
}
}
}
# END OF CREATE COMPONENT AND ASIGN THICKNESS
proc reflect_entities {} {
proc optistruct {n t} {
*createmark comps 1 $n
if {[hm_entityinfo exist comps $n] !=0} {
tk_messageBox -message "The Component already exists" -icon warning -type ok -title Message
} else {
*createentity comps cardimage=Part includeid=0 name=$n;
*createmark comps 1 $n
set compid [hm_getmark comps 1]
*createentity props cardimage=PSHELL includeid=0 name=$n;
*createmark props 2 $n
set propid [hm_getmark props 2]
*setvalue props id=$propid STATUS=1 95=$t;
*setvalue comps id=$compid propertyid={props $propid};
}
}
proc radioss {n t} {
*createmark comps 1 $n
if {[hm_entityinfo exist comps $n] !=0} {
tk_messageBox -message "The Component already exists" -icon warning -type ok -title Message
} else {
*createentity comps cardimage=Part includeid=0 name=$n;
*createmark comps 1 $n
set compid [hm_getmark comps 1]
*createentity props cardimage=P1_SHELL includeid=0 name=$n;
*createmark props 2 $n
set propid [hm_getmark props 2]
*setvalue props id=$propid STATUS=1 431=$t;
*setvalue comps id=$compid propertyid={props $propid};
}
}
proc reflect {} {
*clearmarkall 1; *clearmarkall 2;
set name [hm_getstring Component_Name "Enter name of reflect component followed by _"]
*createmarkpanel comps 1 "Select the component containing original geometry to be reflected"
set o_geom [hm_getmark comp 1]
*createmarkpanel comps 1 "Select the component containing target geometry"
set t_geom [hm_getmark comp 1]
*createmarkpanel comps 1 "Select the FE components you want to reflect"
set o_fea [hm_getmark comps 1]
set profile [hm_getsolver]
foreach i $o_fea {
set t [hm_getthickness comps $i]
set old_n [hm_entityinfo name comps $i]
set n $name$t
if {$profile == "radioss" ||$profile == "optistruct"} {
$profile $n $t
} else {tk_messageBox -message "Solver not available in the student version" -icon warning -type ok -title Message}
*createmark elements 1 $old_n
*copymark elements 1 $n
*displaycollectorwithfilter components "off" "$old_n" 1 0
}
*createmark comps 2 "displayed"
*autocolorwithmark components 2
*clearmarkall 1; *clearmarkall 2;
*createmark surfaces 1 "by collector" $o_geom
set o_cog [hm_getcentroid surfaces 1]
*createnode [lindex $o_cog 0] [lindex $o_cog 1] [lindex $o_cog 2] 0
*createmark node 2 -1
set o_node [hm_getmark node 2]
*createmark surfaces 1 "by collector" $t_geom
set t_cog [hm_getcentroid surfaces 1]
*createnode [lindex $t_cog 0] [lindex $t_cog 1] [lindex $t_cog 2] 0
*createmark node 2 -1
set t_node [hm_getmark node 2]
set intercepts [hm_getdistance nodes $o_node $t_node 0];
*clearmarkall 1;
*createnodesbetweennodes $o_node $t_node 1;
*createmark nodes 1 -1
set m_node [hm_getmark nodes 1];
set m_node_info [hm_nodevalue $m_node];
*clearmarkall 1;
*createmark elements 1 "displayed"
*createplane 1 [lindex $intercepts 1] [lindex $intercepts 2] [lindex $intercepts 3] [lindex $m_node_info 0 0] [lindex $m_node_info 0 1] [lindex $m_node_info 0 2]
*reflectmarkwithoption elements 1 1 0;
*clearmarkall 1; *clearmarkall 2;
*createmark component 1 "displayed"
*equivalence components 1 0.01 1 0 0
}
reflect;
}
#END OF REFLECT ENTITES
proc edges_f_T {} {
set e .window
catch {destroy $e}
toplevel $e -class Toplevel
wm title $e "EDGE CORRECTION"
wm geometry $e 300x250+100+100
wm resizable $e 0 0
wm deiconify $e
button $e.11 -text "FREE EDGES" -command {free_edges} -bg yellow -font {times 10 bold}; place $e.11 -x 20 -y 20 -width 250 -height 40
button $e.21 -text "T EDGES" -command {t_edges} -bg yellow -font {times 10 bold}; place $e.21 -x 20 -y 80 -width 250 -height 40
button $e.31 -text "HIDE" -command {hide} -bg yellow -font {times 10 bold}; place $e.31 -x 20 -y 140 -width 250 -height 40
button $e.2 -text "BACK" -command "destroy $e; m_wind;" -bg red -font {times 12 bold}; place $e.2 -x 20 -y 190 -width 250 -height 40
proc free_edges {} {
*clearmarkall 1;
*createmark elems 1 "displayed"
if {[hm_marklength elems 1]!=0} {
*createmark comps 1 "Free_Edges"
if {[hm_marklength comps 1]!=0} { *deletemark comps 1}
*createmark elems 1 "displayed"
*findedges elems 1 0 0 0 30
*createentity comps name="Free_Edges" color=3
*createmark elems 2 "by collector" {^edges}
if {[hm_marklength elems 2]!=0} { *movemark elems 2 "Free_Edges"
*createmark comps 2 "^edges"; *deletemark comps 2
*setdisplayattributes 4 1
*setcomponentdisplayattributes "Free_Edges" 2 1 }
p_equiv
} else {tk_messageBox -message "Not found." -icon info -type ok}
}
proc t_edges {} {
*setdisplayattributes 4 1
*clearmarkall 1;
*createmark elems 1 "displayed"
if {[hm_marklength elems 1]!=0} {
*createmark comps 1 "T_Edges"
if {[hm_marklength comps 1]!=0} { *deletemark comps 1}
*createmark elems 1 "displayed"
*findedges elems 1 1 0 0 30
*createentity comps name="T_Edges" color=30
*createmark elems 2 "by collector" {^edges}
if {[hm_marklength elems 2]!=0} { *movemark elems 2 "T_Edges"
*createmark comps 2 "^edges"; *deletemark comps 2
*setdisplayattributes 4 1
*setcomponentdisplayattributes "T_Edges" 4 1
} else {tk_messageBox -message "Not found." -icon info -type ok}
p_equiv
}
}
proc p_equiv {} {
*clearmarkall 1;
*clearmarkall 2;
*createmark elems 1 "displayed"
*equivalence elems 1 0.01 3 0 0
*createmark nodes 1 "retrieve"
*nodemarkaddtempmark 1
}
proc hide {} {
*clearmarkall 1;
*clearmarkall 2;
*createmark comps 1 "all"
if {[hm_entityinfo exist comps ^edges]==1} { puts 3;*createmark comps 1 "^edges"; *deletemark comps 1}
*createmark comps 1 "all"
if {[hm_entityinfo exist comps Free_Edges]==1} { puts 2; *createmark comps 1 "Free_Edges"; *deletemark comps 1}
*createmark comps 1 "all"
if {[hm_entityinfo exist comps T_Edges]==1} { puts 1; *createmark comps 1 "T_Edges"; *deletemark comps 1}
*setdisplayattributes 2 1
}
}
#END OF FREE EDGES AND T-EDGES
proc create_entities_re_rn {} {
set a .window
catch {destroy $a}
toplevel $a -class Toplevel
wm title $a "FINAL CHECKS"
wm geometry $a 600x650+300+150
wm resizable $a 0 0
wm deiconify $a
label $a.label1 -text "TO DELETE ENTITIES" -bg grey -font {times 12 bold}; place $a.label1 -x 25 -y 20 -width 550 -height 30
label $a.label2 -text "TO REMOVE EMPTY ENTITIES" -bg grey -font {times 12 bold}; place $a.label2 -x 25 -y 110 -width 550 -height 30
label $a.label3 -text "REORDER ENTITIES BY NAME" -bg grey -font {times 12 bold}; place $a.label3 -x 25 -y 290 -width 550 -height 30
label $a.label4 -text "REORDER ENTITIES BY ID" -bg grey -font {times 12 bold}; place $a.label4 -x 25 -y 390 -width 550 -height 30
label $a.label5 -text "RENUMBER ENTITIES" -bg grey -font {times 12 bold}; place $a.label5 -x 25 -y 480 -width 550 -height 30
label $a.label6 -text "***********************************************************************************************" -bg grey -font {times 8 bold}; place $a.label6 -x 25 -y 560 -width 550 -height 15
# DELETE SURFACES, POINTS, LINES AND SOLIDS ##########
button $a.11 -text "DELETE SURFACES" -command {set i surfaces; delete $i} -bg yellow -font {times 8 bold}; place $a.11 -x 25 -y 70 -width 130 -height 20
button $a.12 -text "DELETE POINTS" -command {set i points; delete $i} -bg yellow -font {times 8 bold}; place $a.12 -x 165 -y 70 -width 130 -height 20
button $a.13 -text "DELETE LINES" -command {set i lines; delete $i} -bg yellow -font {times 8 bold}; place $a.13 -x 305 -y 70 -width 130 -height 20
button $a.14 -text "DELETE S0LIDS" -command {set i solids; delete $i} -bg yellow -font {times 8 bold}; place $a.14 -x 445 -y 70 -width 130 -height 20
proc delete {i} {
*createmark $i 1 "displayed"
if {[hm_marklength $i 1!=0]} {*deletemark $i 1}
}
# REMOVE EMPTY ENTITIES ##########
button $a.21 -text "EMPTY COMPS" -command {set j comps; empty $j} -bg yellow -font {times 8 bold}; place $a.21 -x 25 -y 160 -width 135 -height 20
button $a.22 -text "EMPTY ASSEMBLY" -command {set j assembly; empty $j} -bg yellow -font {times 8 bold}; place $a.22 -x 165 -y 160 -width 135 -height 20
button $a.23 -text "EMPTY LOAD COLL" -command {set j loadcollectors; empty $j} -bg yellow -font {times 8 bold}; place $a.23 -x 305 -y 160 -width 135 -height 20
button $a.24 -text "EMPTY LOAD STEP" -command {set j loadsteps; empty $j} -bg yellow -font {times 8 bold}; place $a.24 -x 445 -y 160 -width 135 -height 20
button $a.31 -text "UNUSED GROUPS" -command {set c groups; unused $c} -bg yellow -font {times 8 bold}; place $a.31 -x 25 -y 200 -width 135 -height 20
button $a.32 -text "UNUSED CROSS SECTION" -command {set c crosssections; unused $c} -bg yellow -font {times 7 bold}; place $a.32 -x 165 -y 200 -width 135 -height 20
button $a.33 -text "UNUSED SET" -command {set c sets; unused $c} -bg yellow -font {times 8 bold}; place $a.33 -x 305 -y 200 -width 135 -height 20
button $a.34 -text "UNUSED CURVE" -command {set c curves; unused $c} -bg yellow -font {times 8 bold}; place $a.34 -x 445 -y 200 -width 135 -height 20
button $a.41 -text "UNUSED CONTACTS" -command {set c contacts; unused $c} -bg yellow -font {times 8 bold}; place $a.41 -x 25 -y 240 -width 135 -height 20
button $a.42 -text "UNUSED MATS" -command {set c materials; unused $c} -bg yellow -font {times 8 bold}; place $a.42 -x 165 -y 240 -width 135 -height 20
button $a.43 -text "UNUSED PROPERTIES" -command {set c properties; unused $c} -bg yellow -font {times 8 bold}; place $a.43 -x 305 -y 240 -width 135 -height 20
button $a.44 -text "UNUSED BEAM SEC" -command {set c beamsections; unused $c} -bg yellow -font {times 8 bold}; place $a.44 -x 445 -y 240 -width 135 -height 20
proc empty {j} {
*EntityPreviewEmpty $j 1
if {[hm_marklength $j 1!=0]} {*deletemark $j 1}
}
proc unused {c} {
*EntityPreviewUnused $c 1
if {[hm_marklength $c 1!=0]} {*deletemark $c 1}
}
# REORDER ##########
button $a.51 -text "REORDER COMPONENTS" -command {set k comps; reorder_name $k} -bg yellow -font {times 9 bold}; place $a.51 -x 80 -y 340 -width 200 -height 30
button $a.52 -text "REORDER PROPERTIES" -command {set k properties; reorder_name $k} -bg yellow -font {times 9 bold}; place $a.52 -x 310 -y 340 -width 200 -height 30
button $a.61 -text "REORDER COMPONENTS" -command {set l comps; reorder_id $l} -bg yellow -font {times 9 bold}; place $a.61 -x 80 -y 440 -width 200 -height 30
button $a.62 -text "REORDER PROPERTIES" -command {set l properties; reorder_id $l} -bg yellow -font {times 9 bold}; place $a.62 -x 310 -y 440 -width 200 -height 30
proc reorder_name {k} {
*clearmarkall 1
*createmark $k 1 "all"
if {[hm_marklength $k 1!=0]} {
*collectormarkmove $k 1 1 1}
}
proc reorder_id {l} {
*clearmarkall 1
*createmark $l 1 "all"
if {[hm_marklength $l 1!=0]} {
*collectormarkmove $l 1 1 2}
}
# RENUMBER ##########
button $a.71 -text "RENUMBER COMPONENTS" -command {set m comps; renumber $m} -bg yellow -font {times 9 bold}; place $a.71 -x 80 -y 520 -width 200 -height 25
button $a.72 -text "RENUMBER PROPERTIES" -command {set m properties; renumber $m} -bg yellow -font {times 9 bold}; place $a.72 -x 310 -y 520 -width 200 -height 25
button $a.73 -text "BACK" -command "destroy $a; m_wind;" -bg red -font {times 12 bold}; place $a.73 -x 310 -y 590 -width 200 -height 25
proc renumber {m} {
*clearmarkall 1
*createmark $m 1 "all"
if {[hm_marklength $m 1!=0]} {
*renumber $m 1 10000 1 0 0}
}
# MASTER BUTTON ##########
button $a.82 -text "MASTER" -command { master} -bg red -font {times 11 bold}; place $a.82 -x 70 -y 590 -width 200 -height 25
proc master {} {
set b {surfaces poins lines solids}; foreach i $b {delete $i}
set b {comps assembly loadcollectors loadsteps}; foreach j $b {empty $j}
set b {groups crosssections curves contacts materials properties beamsections}; foreach c $b {unused $c}
set b {components properties}; foreach k $b {reorder_name $k}
set b {components properties}; foreach l $b {reorder_id $l}
set b {components properties}; foreach m $b {renumber $m}
}
}
}
m_wind;
GRAPHICAL USER INTERFACE:
https://drive.google.com/file/d/1VBkXQBeqIjzL4OyAaNL_YzIhrRoXh_nP/view?usp=sharing
CONCLUSION:
- Learned to create multiple windows linked to a single window.