home *** CD-ROM | disk | FTP | other *** search
/ Computer Shopper 182 / dpcs0403.iso / Business / Amapi 5.15 / Amapi5.15w / data1.cab / Common / Macros / Cone.tcl < prev    next >
Encoding:
Text File  |  2001-06-05  |  1.3 KB  |  54 lines
  1. #SPEC -realnameid 0
  2.  
  3. # messages table
  4. #@@%000@@FR@@Faire un cone@@
  5. #@@%000@@US@@Make a cone@@
  6. #@@%001@@FR@@nb tranches@@
  7. #@@%001@@US@@steps@@
  8. #@@%002@@FR@@hauteur@@
  9. #@@%002@@US@@height@@
  10. #@@%003@@FR@@rayon@@
  11. #@@%003@@US@@radius@@
  12.  
  13. .amapi loadmsg Cone.tcl mymsg
  14. set res [getvalue \
  15.     -type1 ''int'' -name1 ''[mymsg -ref 1]'' -value1 10 \
  16.     -type2 ''world'' -name2 ''[mymsg -ref 2]'' -value2 5 \
  17.     -type3 ''world'' -name3 ''[mymsg -ref 3]'' -value3 4]
  18. mymsg -free
  19. if {$res == ""} return
  20.  
  21. set nbslices [.match $res result1 -int]
  22. set high [.match $res result2 -world]
  23. set radiu [.match $res result3 -world]
  24.  
  25. set oldplane [.amapi plane]
  26. .amapi setplane -viewup
  27. set origin {0 0 0}
  28.  
  29. set circ [.match [circle -radius [.world2unit $radiu] -numpts $nbslices -orig $origin] shape -shape]
  30. if {$circ == ""} return
  31.  
  32. newshape mycircle $circ
  33.  
  34. .amapi setplane -viewfront
  35.  
  36. set pt1 [list [lindex $origin 0] [lindex $origin 1] [expr [lindex $origin 2] + $radiu]]
  37. set pt2 [list [lindex $origin 0] [expr [lindex $pt1 1] + $high] [lindex $origin 2]]
  38.  
  39. newshape myprofil {
  40.     addpoint $pt1
  41.     addpoint $pt2
  42. }
  43. myprofil -status open 
  44. myprofil -checkin
  45.  
  46. set prof [myprofil -ref]
  47. set profil [smooth -shape $prof -range $nbslices]
  48.  
  49. extrude -curve1 $circ -curve2 $profil -close
  50.  
  51. set newplane [.match $oldplane plane -string]
  52. .amapi setplane $newplane
  53.  
  54.