home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / V4 / tcw.z / colors.bas < prev    next >
BASIC Source File  |  1997-10-28  |  1KB  |  65 lines
  1. 'Script that will select by color and then save selection as new file.
  2.  
  3. Sub Main()
  4. Dim hDrawing As Long
  5. Dim g As Long
  6. Dim Result As Long
  7. Dim q As Long
  8. Dim dName As String
  9. Dim dName1 As String
  10. Dim pos As Integer
  11. Dim L  As Integer
  12.  
  13. hDrawing = TCWDrawingActive()
  14.  
  15. if hDrawing = 0 then
  16.    MsgBox "Must have an active drawing"
  17.    Stop
  18. end if
  19.  
  20. q=0
  21.  
  22.  TCWDrawingName dName1
  23. L=len(dName1)
  24. pos=InStr(1,dName1,".")
  25. if (pos<>L-3) Then 
  26. dName=dName1 +".tcw"
  27.  else 
  28. dName=dName1
  29. end if
  30.  
  31. g = TCWSelectByQuery("PenColor = Red")
  32.  
  33. if g <> 0 then
  34. q=1  
  35.  Result = TCWDrawingSaveAs("Red.tcw", True)
  36. end if
  37.  
  38. g = TCWSelectByQuery("PenColor=Blue")
  39. if g <> 0 then
  40.    Result = TCWDrawingSaveAs("Blue.tcw", True)
  41. q=1  
  42. end if
  43.  
  44. Dim clr as string
  45. Dim Dg
  46. 'Dark Green needs to be quoted, so we have to build our
  47. 'query string Color = "Dark Green"
  48. clr = "PenColor = " & chr(34) & "Dark Green" & chr(34)
  49. g = TCWSelectByQuery(clr)
  50. if g <> 0 then
  51.    Result = TCWDrawingSaveAs("Green.tcw", True)
  52. q=1  
  53. end if
  54.  
  55. S$="TurboCAD"
  56. if q=0 Then
  57. result = MsgBox ("Need to have at least one graphic Red, Blue or Dark Green",0,S$)
  58. ' MsgBox "No grafics found"
  59.    Stop
  60. end if
  61. result=TCWDeselectAll()
  62. Result = TCWDrawingSaveAs(dName,True)
  63. result=MsgBox ("Finished",0,S$)
  64. End Sub
  65.