home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / OTTSPAR1.DMS / in.adf / LWMmacros / Subdivide.lwm < prev   
Encoding:
Text File  |  2012-12-18  |  3.0 KB  |  162 lines
  1. /* CMD: SubDivider
  2.  * Make Ginsu of your Model in Modeler  *
  3. * By Jon Tindall Copyright © 1993 MetroGrafx *
  4. * fri feb  26  1993 revised 24june93 */
  5.  
  6. arg xgrid ygrid zgrid
  7. if xgrid="" then xgrid=3
  8. if ygrid="" then ygrid=3
  9. if zgrid="" then zgrid=3
  10. Ax='Y'
  11. address "LWModelerARexx.port"
  12. libadd = addlib("LWModelerARexx.port",0)
  13.  
  14. SIGNAL ON ERROR
  15. SIGNAL ON SYNTAX
  16. sysnam = 'Slicer'
  17.  
  18. call req_begin sysnam
  19.  
  20.  
  21. xgridId = req_addcontrol("X Grid",'N',0)
  22. ygridId = req_addcontrol("Y Grid",'N',0)
  23. zgridId = req_addcontrol("Z Grid",'N',0)
  24.  
  25.  
  26. call req_setval xgridId, 3
  27. call req_setval ygridId, 3
  28. call req_setval zgridId, 3
  29.  
  30.  
  31. x = req_post()
  32. if (x) then do
  33.     xgrid= req_getval(xgridId)
  34.     ygrid= req_getval(ygridId)
  35.     zgrid= req_getval(zgridId)
  36.  
  37.     if xgrid<1 then xgrid=1
  38.     if ygrid<1 then ygrid=1
  39.     if zgrid<1 then zgrid=1
  40.     call req_end()
  41.  end
  42. else do
  43.     call req_end()
  44.     exit
  45.  end
  46.  
  47.  
  48. CurLay=curlayer()
  49. box=boundingbox()  /* Should check out empty list ...  */
  50. parse var box n x1 x2 y1 y2 z1 z2
  51. s1="!Layer "CurLay": " n" Points"
  52. s2="!Object Bounds"
  53. s3='@'x1 y1 z1     /* low values */
  54. s4='@'x2 y2 z2     /* high values */
  55.  
  56. xcube=(x2-x1)/xgrid
  57. ycube=(y2-y1)/ygrid
  58. zcube=(z2-z1)/zgrid
  59.  
  60.  
  61. empty=emptylayers()
  62.  
  63. if empty~="" then do
  64. scr=word(empty,1)
  65. End
  66. else do
  67. call notify 1, '@'sysnam, "!Need an empty layer for scratch work."
  68.     exit 10
  69. return
  70. end
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77. If ygrid>1 Then Do
  78.    call setlayer(scr)
  79.    call Add_Begin
  80.    call ADD_POINT(x1-xcube y1+ycube 0)          /* build y slices */
  81.    call ADD_POINT(x2+xcube y1+ycube 0)
  82.    call ADD_POLYGON(1 2)
  83.    call Add_end
  84.  
  85.       do n=1 to ygrid-2
  86.          IF n=1 then do
  87.          call COPY()
  88.          end
  89.          call MOVE(0 ycube 0)
  90.          call PASTE()
  91.          
  92.        END
  93.     call setlayer(CurLay)
  94.     call setblayer(scr)
  95.     call AXISDRILL('SLICE', 'Z')
  96.     call setlayer(scr)
  97.    call CUT()
  98. END
  99.  
  100.  
  101.  If xgrid>1 Then Do
  102.    call setlayer(scr)
  103.  
  104.    call Add_Begin
  105.    call ADD_POINT(x1+xcube y1-ycube 0)          /* build x slices */
  106.    call ADD_POINT(x1+xcube y2+ycube 0)
  107.    call ADD_POLYGON(1 2)
  108.    call Add_end
  109.  
  110.       do n=1 to xgrid-2
  111.          IF n=1 then do
  112.          call COPY()
  113.          end
  114.          call MOVE(xcube 0 0)
  115.          call PASTE()
  116.  
  117.        END
  118.     call setlayer(CurLay)
  119.     call SETBLAYER(scr)
  120.     call AXISDRILL('SLICE', 'Z')
  121.     call setlayer(scr)
  122.     call CUT()
  123. END
  124.  
  125.  
  126.  
  127.  
  128. If zgrid>1 Then Do
  129.    call setlayer(scr)
  130.    call Add_Begin
  131.    call ADD_POINT(0 y1-ycube z1+zcube)     /*  build Z slices  */
  132.    call ADD_POINT(0 y2+ycube z1+zcube)
  133.    call ADD_POLYGON(1 2)
  134.    call Add_end
  135.  
  136.    do n=1 to zgrid-2
  137.      IF n=1 then do
  138.           call COPY()
  139.      end
  140.      call MOVE (0 0 zcube)
  141.      call PASTE()
  142.    END
  143.  
  144.    call setlayer(CurLay)
  145.    call setblayer(scr)
  146.    call axisdrill('slice', 'x')
  147.    call setlayer(scr)
  148.    call CUT()
  149.  call setlayer(CurLay)
  150. END
  151.  
  152. EXIT
  153.  
  154. SYNTAX:
  155. ERROR:
  156.   say 'Sorry, Error #'RC' on line 'SIGL' has been detected.'
  157.   say errortext(rc)
  158.   t=Notify(1,'!Well, Byte Me!','!An error has occured.','@'ErrorText(rc),'Line 'SIGL,sourceline(SIGL))
  159.   call end_all
  160.   exit
  161.  
  162.