home *** CD-ROM | disk | FTP | other *** search
/ DTP Toolbox / DTPToolbox.iso / propage4.0 / arexx / measurearea.pdrx < prev    next >
Encoding:
Text File  |  1994-04-06  |  9.3 KB  |  314 lines
  1. /*
  2. Routine to measure area of selected objects. (Based on the routine to export Ishapes for ImageMaster). 
  3. Written by Don Cox, Apr '94. Copyright. Not Public Domain.
  4. */
  5. /* $VER: MeasureArea April 94 */
  6.  
  7.  
  8. msg = PDSetup.rexx(2,0) /* load gdarexxsupport.library */
  9. units = getclip(pds_units)
  10. if msg ~= 1 then exit_msg(msg)
  11. call pdm_SetWireFrame(1)
  12. if units = 3 then call pdm_SetUnits(2) /* work in cm */
  13.  
  14. numeric digits 7
  15.  
  16. cr = '0a'x
  17.  
  18. call pdm_ShowStatus("  Analysing objects...")
  19. success = open("Output","ram:tempfile","W")
  20. if success = 0 then exit_msg("Temporary file could not be opened")
  21.  
  22.  
  23. string = ""
  24.  
  25. /* First go through getting rough size, for setting point intervals for curve conversion */
  26. object = pdm_SelFirstObj()
  27. objectnumber = 1
  28. totalpoints = 0
  29.  
  30. if object = 0 then exit_msg("No objects selected")
  31. do until object = 0
  32.     if pdm_IsEllipse(object) = 1 then call pdm_EllipseToGraphic(object)
  33.     if pdm_IsText(object) = 1 then do
  34.         textobject = pdm_SelectObj(object)
  35.         call pdm_TextToGraphic()
  36.         end
  37.     if pdm_IsBezier(object)=1 then do
  38.         numpoints = pdm_GetObjOrder(object)
  39.         totalpoints = totalpoints+numpoints
  40.         VisSize = pdm_GetObjVisSize(object)
  41.         VisPos = pdm_GetObjVisPosn(object)
  42.         parse var VisSize VisWidth VisHeight
  43.         parse var VisPos Xcoord Ycoord
  44.         if objectnumber = 1 then do
  45.             smallestY = Ycoord /* pick up first Y value in file */
  46.             smallestX = Xcoord
  47.             biggestX = Xcoord
  48.             biggestY = Ycoord
  49.             end
  50.         if Ycoord>biggestY then biggestY = Ycoord
  51.         if Ycoord<smallestY then smallestY = Ycoord
  52.         if Xcoord>biggestX then biggestX = Xcoord
  53.         if Xcoord<smallestX then smallestX = Xcoord
  54.  
  55.         Ycoord = Ycoord+VisHeight /* Look at bottom right corner */
  56.         Xcoord = Xcoord+VisWidth
  57.         if Ycoord>biggestY then biggestY = Ycoord
  58.         if Ycoord<smallestY then smallestY = Ycoord
  59.         if Xcoord>biggestX then biggestX = Xcoord
  60.         if Xcoord<smallestX then smallestX = Xcoord
  61.  
  62.         end
  63.  
  64.  
  65. /* Grid routines cannot be used yet due to bug in PDraw IsGrid command
  66.     if pdm_IsGrid(object)=1 then do
  67.         numpoints = 4
  68.         totalpoints = totalpoints+numpoints
  69.         VisSize = pdm_GetObjVisSize(object)
  70.         VisPos = pdm_GetObjVisPosn(object)
  71.         parse var VisSize VisWidth VisHeight
  72.         parse var VisPos Xcoord Ycoord
  73.         if objectnumber = 1 then do
  74.             smallestY = Ycoord /* pick up first Y value in file */
  75.             smallestX = Xcoord
  76.             biggestX = Xcoord
  77.             biggestY = Ycoord
  78.             end
  79.         if Ycoord>biggestY then biggestY = Ycoord
  80.         if Ycoord<smallestY then smallestY = Ycoord
  81.         if Xcoord>biggestX then biggestX = Xcoord
  82.         if Xcoord<smallestX then smallestX = Xcoord
  83.  
  84.         Ycoord = Ycoord+VisHeight /* Look at bottom right corner */
  85.         Xcoord = Xcoord+VisWidth
  86.         if Ycoord>biggestY then biggestY = Ycoord
  87.         if Ycoord<smallestY then smallestY = Ycoord
  88.         if Xcoord>biggestX then biggestX = Xcoord
  89.         if Xcoord<smallestX then smallestX = Xcoord
  90.         end  /* of grid */
  91.  
  92. */
  93.  
  94.     object = pdm_SelNextObj(object)
  95.     objectnumber = objectnumber+1
  96.     end
  97.  
  98. if objectnumber = 1 then exit_msg("No objects selected")
  99.  
  100.  
  101. /* This is what we really want but the sqrt function in the gdarexxsupport.library doesn't work.
  102. totalpoints = trunc(sqrt(totalpoints)*20) */
  103.  
  104. totalpoints = totalpoints*2 /* will have to do instead */
  105. if totalpoints>300 then totalpoints=300 /* arbitrary limits */
  106. if totalpoints<40 then totalpoints=40
  107.  
  108. resolution = pdm_GetForm("Set curve point resolution", 10,"Resolution number :"totalpoints)
  109. if ~datatype(resolution,n) then resolution = 60
  110.  
  111.  
  112.  
  113. /* This time, convert curves and get accurate size */
  114. totalsize = (biggestX-smallestX)+(biggestY-smallestY)
  115. oldControl2X = 0
  116. oldControl2Y = 0
  117. oldXcoord = 0
  118. oldYcoord = 0
  119.  
  120. object = pdm_SelFirstObj()
  121. objectnumber = 1
  122. gridflag = 0 /* grid as lines or dots requester flag  */
  123.  
  124.  
  125. do until object = 0
  126.     if pdm_IsBezier(object)=1 then do
  127.         numpoints = pdm_GetObjOrder(object)
  128.         numpoints = numpoints -1  /* Counts from zero */
  129.         pointnumber = 0
  130.         do until pointnumber > numpoints
  131.             pointinfo = pdm_GetPoint(object, pointnumber)
  132.             parse var pointinfo Xcoord Ycoord control1X control1Y control2X control2Y
  133.             pointinfo = Xcoord" "Ycoord||cr  /* default for straight lines */
  134.  
  135.             /* See if it's a curved line and add points if so */
  136.             if (control1X~=0 | control1Y~=0 | oldControl2X~=0 | oldControl2Y~=0) & pointnumber ~=0 & resolution~=0 then call Bezier2
  137.  
  138.             oldControl2X = control2X
  139.             oldControl2Y = control2Y
  140.             oldXcoord = Xcoord
  141.             oldYcoord = Ycoord
  142.             string = string||pointinfo
  143.             if length(string)>20000 then do
  144.                 call writech("Output",string)
  145.                 string = ""
  146.                 end
  147.             pointnumber = pointnumber+1
  148.             end
  149.         end
  150.  
  151.  
  152. /* Grid routines cannot be used yet due to bug in PDraw IsGrid command
  153.     if pdm_IsGrid(object)=1 then do
  154.         if gridflag = 0 then do
  155.             gridformat = pdm_Inform(2,"Save grid as lines or dots?","Lines","Dots")
  156.             gridflag = 1 /* don't ask again */
  157.             end
  158.         numlines = pdm_GetGridOrder(object)
  159.         numpoints = 4
  160.         pointnumber = 0
  161.         do until pointnumber > numpoints
  162.             pointinfo = pdm_GetPoint(object, pointnumber)
  163.             parse var pointinfo Xcoord Ycoord 
  164.             gridcoords.pointnumber.Xcoord = Xcoord
  165.             gridcoords.pointnumber.Ycoord = Ycoord
  166.             string = string||pointinfo
  167.             if gridformat = 1 then string = string||cr
  168.             if length(string)>20000 then do
  169.                 call writech("Output",string)
  170.                 string = ""
  171.                 end
  172.             pointnumber = pointnumber+1
  173.             call gridexpand
  174.             end
  175. */
  176.  
  177.     object = pdm_SelNextObj(object)
  178.     objectnumber = objectnumber+1
  179.     string = string||cr /* Blank line between objects */
  180.     end
  181.  
  182. call writech("Output",string)
  183. call finalize
  184.  
  185. n = 2.54*2.54
  186. if units = 2 then do
  187.     total1 = totalarea
  188.     total2 = totalarea/n
  189.     end
  190. else if units = 1 then do
  191.     total1 = totalarea*n
  192.     total2 = totalarea
  193.     end
  194. total1 = trunc(total1,3)
  195. total2 = trunc(total2,3)
  196.  
  197. exit_msg("  Area is "total1" square cm, "total2" square ins  ")
  198.  
  199. /* +++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */
  200.  
  201. exit_msg()
  202.  
  203. exit_msg: procedure expose units
  204. do
  205.     parse arg message
  206.  
  207.     if message ~= '' then call pdm_Inform(1,message,)
  208.     call pdm_ClearStatus()
  209.     call pdm_SetUnits(units)
  210.     call pdm_AutoUpdate(1)
  211.     exit
  212. end
  213.  
  214.  
  215. /* ++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++ */
  216.  
  217. Bezier2:
  218. /* Bezier2.SUB              
  219. From Fundamentals of Interactive Computer Graphics
  220. From article by Steve Enns in Byte, Dec. '86
  221. (2D version only)
  222.  
  223. Calculates cubic parametric freeform Bezier curves
  224.  
  225. XC.,YC. are the coords of the 4 hull points, which are the current and previous points and their inner control points. */
  226.  
  227. XC.1 = oldXcoord
  228. XC.2 = oldControl2X+oldXcoord /* control handle coords are relative */
  229. XC.3 = control1X+Xcoord
  230. XC.4 = Xcoord
  231. YC.1 = oldYcoord
  232. YC.2 = oldControl2Y+oldYcoord
  233. YC.3 = control1Y+Ycoord
  234. YC.4 = Ycoord
  235. curvesize = abs(Xcoord-oldXcoord)+abs(Ycoord-oldYcoord)
  236. curveratio = curvesize/totalsize
  237. increment = 1/(resolution * curveratio)
  238. if increment>0.5 then increment = 0.5 /* just put 1 in the middle */
  239.  
  240. /* Returns CurveXcoord. and CurveYcoord. as the points
  241. Returns XNS as the number of curve points
  242. */
  243.  
  244. IS=1
  245. pointinfo = ""
  246.  
  247. do T=increment to 0.98 by increment /* 0.98 so as not to do a point right at the end of the curve, too close to first poit of next curve */
  248.     T2=T*T
  249.     T3=T2*T
  250.     NC1=1-3*T+3*T2-T3
  251.     NC2=3*T3-6*T2+3*T
  252.     NC3=3*T2-3*T3
  253.     NC4=T3
  254.     CurveXcoord=(NC1*XC.1)+(NC2*XC.2)+(NC3*XC.3)+(NC4*XC.4)
  255.     CurveYcoord=(NC1*YC.1)+(NC2*YC.2)+(NC3*YC.3)+(NC4*YC.4)
  256.     pointinfo = pointinfo||CurveXcoord" "CurveYcoord||cr
  257.     IS=IS+1
  258.     end
  259.  
  260. pointinfo = pointinfo||Xcoord" "Ycoord||cr
  261. XNS = IS-1 /* number of points */
  262.  
  263. RETURN
  264.  
  265. /* +++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */
  266.  
  267. gridexpand:  /* do the other points of a grid */
  268.  
  269. return
  270.  
  271. /* ++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++ */
  272.  
  273. finalize:  /* Calculate area from file of coordinates. Algorithm from Stolk & Ettershank, Byte Feb. '87, pp.135-6. */
  274.  
  275. call pdm_ShowStatus("  Calculating area...")
  276. call seek("Output",0,"B")
  277. area = 0
  278. totalarea = 0
  279. oldXnumber=0
  280. oldYnumber=0
  281. linecount = 1
  282. firstX = 0
  283. firstY = 0
  284.  
  285. do until eof("Output")
  286.     numbers = readln("Output")
  287.     parse var numbers Xnumber Ynumber
  288.     if datatype(Xnumber,n) & datatype(Ynumber,n) then do
  289.         area = area + (oldXnumber*Ynumber) - (oldYnumber*Xnumber)
  290.         if linecount = 1 then do /* for open/closed check */
  291.             firstX = Xnumber
  292.             firstY = Ynumber
  293.             end
  294.         linecount = linecount+1
  295.         oldXnumber = Xnumber
  296.         oldYnumber = Ynumber
  297.         end
  298.     else do /* blank line between objects */
  299.         if ~(oldXnumber = firstX & oldYnumber = firstY) then area = 0 /* not a closed object */
  300.         linecount = 1
  301.         totalarea = totalarea+area
  302.         area = 0
  303.         oldXnumber=0
  304.         oldYnumber=0
  305.         end
  306.     end
  307. totalarea = abs(totalarea)/2
  308. call close("Output")
  309. /*address command
  310. 'delete "ram:tempfile"'*/
  311. return 
  312.  
  313.  
  314.