home *** CD-ROM | disk | FTP | other *** search
/ Corel Draw 7 / CD7_CAD.ISO / cad / command.csc < prev    next >
Encoding:
Text File  |  1996-10-28  |  52.1 KB  |  1,989 lines
  1. 'This script simulates a command line. It enables users to perform most CorelCAD commands using a command line interface.
  2. '
  3. '*************************************************************************************
  4. '**********************      COMMAND LINE      **********************************
  5. '*************************************************************************************
  6. '*************************************************************************************
  7. 'April 25, 1996
  8. '
  9. '          This script simulates a command line. It enables the user to perform many CorelCAD 
  10. '    commands using the keyboard. A list of commands and/or objects is available by typing "LIST".         
  11. '
  12. '
  13. '        Coordinate entry is possible through two main methods:
  14. '
  15. '    Normal:             5,5,5
  16. '    Relative:            @5,5,5
  17. '
  18. 'Written by Dave Climie,        ⌐ 1995-1996 Corel Corporation. All rights reserved.
  19. '*************************************************************************************
  20. '*************************************************************************************
  21. '************************      DECLARATIONS      *************************************
  22. '*************************************************************************************
  23. '*************************************************************************************
  24. DECLARE SUB DoMove()
  25. DECLARE SUB DoScale()
  26. DECLARE SUB DoExtrude()
  27. DECLARE SUB DoPaste()
  28. DECLARE SUB DoChangeColor()
  29. DECLARE SUB DoZoom()
  30.  
  31. DECLARE SUB GetCoord (DiaText$,X#,Y#,Z#,ESC%)        'allows user to enter a coordinate (x,y,z)
  32. DECLARE SUB GetValue (DiaText$,dX#,ESC%)            'allows user to enter a magnitude (distance, angle, etc..)
  33. DECLARE SUB GetLetter (TitleText$,DiaText$,LetAvail$,LetPicked$,ESC%)
  34.  
  35. DECLARE SUB Array()                            'array functions
  36.     DECLARE SUB LinearArr(DoOverall%, ESC%)
  37.     DECLARE SUB TwoDArr(DoOverall%, ESC%)
  38.     DECLARE SUB ThreeDArr(DoOverall%, ESC%)    
  39.     DECLARE SUB CircleArr(ESC%)
  40.     DECLARE SUB SpiralArr(ESC%)
  41.     DECLARE SUB SphereArr(ESC%)
  42.  
  43. DECLARE SUB CreateArc()                        'arc drawing functions
  44.     DECLARE SUB CreateArc3Points(WireFlag%, ESC%)        'WIREFLAG FOR PROPERTIES:
  45.     DECLARE SUB CreateArcAngle(WireFlag%, ESC%)                    '0: WIRE ARC
  46.     DECLARE SUB CreateArcCSE(WireFlag%, ESC%)                    '1: CENTER (creates surface)
  47.     DECLARE SUB CreateArcEllipses(WireFlag%, ESC%)                '2: END POINT (creates surface)
  48.     DECLARE SUB CreateArcRSE(WireFlag%, ESC%)
  49.  
  50. DECLARE SUB CreateBox()    'box drawing function
  51.  
  52. DECLARE SUB CreateCircle()    'circle drawing functions
  53.     DECLARE SUB CreateCircle3Point(WireFlag%, ESC%)
  54.     DECLARE SUB CreateCircleDiameter(WireFlag%, ESC%)
  55.     DECLARE SUB CreateCircleRadius(WireFlag%, ESC%)
  56.  
  57. DECLARE SUB CreateCone()                        'draws cone
  58. DECLARE SUB CreateCylinder()                    'draws cylinder
  59.  
  60. DECLARE SUB CreateEllipse()
  61. DECLARE SUB CreateFrustum()
  62. DECLARE SUB CreateHemisphere()
  63. DECLARE SUB CreateLine (PolyFlag%)                'Boolean, True for Polyline, False for Line Segments
  64. DECLARE SUB CreatePolygon()
  65. DECLARE SUB CreateRectangle()
  66. DECLARE SUB CreateSphere()
  67. DECLARE SUB CreateTorus()
  68. '*************************************************************************************
  69. '*****************************    VARIABLE DECLARATIONS   ****************************
  70. '*************************************************************************************
  71.  
  72. GLOBAL Objects$(15)
  73. GLOBAL Command$(30)
  74.  
  75. GLOBAL ObjPicked% 
  76. GLOBAL CmdPicked% 
  77.  
  78.     ObjPicked = 1            'sets these as the default to display to the user
  79.     CmdPicked = 1
  80.  
  81. '*************************************************************************************
  82. '*************************************************************************************
  83. '************************       MAIN      ********************************************
  84. '*************************************************************************************
  85. '*************************************************************************************
  86. '*************************************************************************************
  87.  
  88. DIM Entry$        'Used to store what is typed in by user at command line
  89. DIM WhichList$        ' Stores the type of list the user wants to see
  90.  
  91.  
  92. Message "This Script will only run on Win95 and NT3.51 platforms."
  93.  
  94. Start:
  95.  
  96.     Entry$=""
  97.  
  98.     BEGIN DIALOG Commnd 47, 372, 254, 16, "Command Bar"
  99.         TEXTBOX  82, 2, 79, 13, Entry$
  100.         OKBUTTON  170, 1, 40, 15
  101.         CANCELBUTTON  214, 1, 40, 15
  102.         TEXT  4, 4, 76, 11, "Type Command or (L)ist:"
  103.     END DIALOG
  104.  
  105.     ret=DIALOG(Commnd)
  106.     if ret=2 then stop
  107.  
  108.     Entry$=UCASE(Entry$)
  109.     Entry$=LTRIM(Entry$)
  110.     Entry$=RTRIM(Entry$)
  111.  
  112.  
  113. WITHOBJECT "CorelCAD.Automation.1"
  114.  
  115.  
  116.     SELECT CASE Entry$
  117.         CASE "A","ARC"
  118.             CreateArc
  119.         CASE "AR","ARR","ARRAY"
  120.             Array
  121.         CASE "B","BO","BOX"
  122.             CreateBox
  123.         CASE "C","CIRC","CIRCLE","CIR","CI"
  124.             CreateCircle
  125.         CASE "COL","COLO","COLOR","COLOUR","CHANGE","CHANGE COLOR"    
  126.             DoChangeColor
  127.         CASE "CL","CLOSE"
  128.             .FileClose
  129.         CASE "CO","CONE"
  130.             CreateCone 
  131.         CASE "COPY","COP"
  132.             .EditCopy     
  133.         CASE "CY","CYLINDER","CYL"
  134.             CreateCylinder
  135.         CASE "D","DEF","DEFINE"
  136.             .SolidDefine
  137.         CASE "DEL","DELETE"
  138.             .DeleteSelection
  139.         CASE "DE","DES","DESELECT","DESELECT ALL"
  140.             .SelectPointAt 1000,1000, -1, -1
  141.         CASE "DU","DUPE","DUPLICATE"
  142.             .Duplicate
  143.         CASE "E","ELLIPSE","EL","ELL"
  144.             CreateEllipse
  145.         CASE "EXIT"
  146.             Goto DONEALL    
  147.         CASE "EXPLODE","EX","EXP","EXPL"
  148.             .SolidExplode
  149.         CASE "EXT","EXTRUDE"
  150.             DoExtrude
  151.         CASE "F","FR","FRU","FRUSTUM"
  152.             CreateFrustum
  153.         CASE "G","GR","GRO","GROU","GROUP"
  154.             .Group
  155.         CASE "H","HEMI","HEMISPHERE"
  156.             CreateHemisphere
  157.         CASE "HIDE","HIDDEN","HI"
  158.            .HideEntireView false, false, false, false
  159.         CASE "L","LIST"
  160.             goto LIST
  161.         CASE "LI","LIN","LINE"    
  162.             CreateLine FALSE 
  163.         CASE "M","MO","MOVE"
  164.             DoMove
  165.         CASE "N","NEW"    
  166.             .FileNew
  167.         CASE "PA","PAS","PASTE"
  168.             DoPaste
  169.         CASE "P","PO","POLYLINE"
  170.             CreateLine  TRUE
  171.         CASE "POLY", "POLYGON","TRIANGLE"
  172.                Createpolygon
  173.         CASE    "Q","QUIT"
  174.             Goto DONEALL
  175.         CASE "R","RE","RED","REDO"
  176.             .Redo
  177.         CASE "REC","RECT","RECTANGLE","SQUARE"
  178.             CreateRectangle
  179.         CASE "REF","REFRESH"
  180.             .WireFrame
  181.         CASE "REN","REND","RENDER","RENDER VIEW","RENDERED VIEW","SH","SHADE","SHADE VIEW","SHADED VIEW"
  182.             .ShadeEntireView TRUE, TRUE, 1, TRUE
  183.         CASE "S","SC","SCA","SCALE"
  184.             DoScale
  185.         CASE "SA","SE","SELECTALL","SELECT","SELECT ALL"
  186.             .SelectAll    
  187.         CASE "SP","SPH","SPHERE"
  188.             CreateSphere
  189.         CASE "T","TO","TOR","TORUS"
  190.             CreateTorus
  191.         CASE "U","UN","UND","UNDO"
  192.             .Undo
  193.         CASE "UNG","UNGR","UNGROUP","UN GROUP","UN-GROUP"
  194.             .UnGroup
  195.         CASE "V"
  196.             DoMove
  197.          CASE "W","WI","WIRE","WIREFRAME"
  198.             .WireFrame
  199.         CASE "X"
  200.             .SolidExplode
  201.         CASE "Z","ZOO","ZOOM"
  202.             DoZoom
  203.         CASE "ZA","ZOOM ALL"
  204.             .zoomToAll
  205.         CASE "ZO","ZOOM OUT"
  206.             .zoomout
  207.         CASE "ZI","ZOOM IN"
  208.             T1: 
  209.             GetCoord "Enter the first point for the zoom box:",X#,Y#,Z#,ESC%
  210.             If ESC = true then goto T2
  211.             GetCoord "Enter the end point for the zoom box:",X1#,Y1#,Z1#,ESC%
  212.             If ESC = true then goto T1
  213.             .ZoomIn X,Y,Z,X1,Y1,Z1
  214.             T2:
  215.         CASE "ZP","ZOOM PREVIOUS"
  216.             .zoomprevious
  217.         CASE "ZS","ZOOM SEL","ZOOM SELECTED","ZOOM TO SELECTED"
  218.             .zoomtoselected
  219.         CASE else
  220.             Message "Command does not exist."
  221.             GOTO START
  222.         END SELECT
  223.  
  224.     GOTO START
  225. END WITHOBJECT
  226.  
  227. '*************************************************************************************
  228. LIST:
  229.  
  230. DIM ESC%
  231.  
  232.     ESC = FALSE
  233.     GetLetter "List Type","(C)ommand List or (O)bject List ?","CO",WhichList$,ESC%
  234.  
  235.     If ESC = TRUE then Goto Start
  236.  
  237.     Select Case WhichList    
  238.         CASE "O"
  239.             Goto LISTOBJ
  240.         CASE "C"
  241.             Goto LISTCOM
  242.     End Select
  243.  
  244. '*************************************************************************************
  245. LISTCOM:
  246.  
  247. Command(1) = "Array"
  248. Command(2) = "Change Color"
  249. Command(3) = "Close File"                'This is the list of commands available to be executed
  250. Command(4) = "Copy"                        ' (Displayed when user prompts for command list)
  251. Command(5) = "Define Object"
  252. Command(6) = "Delete"
  253. Command(7) = "Deselect All"
  254. Command(8) = "Draw an object"
  255. Command(9) = "Duplicate"
  256. Command(10) = "Explode Object"
  257. Command(11) = "Extrude"
  258. Command(12) = "Group"
  259. Command(13) = "Hidden Line View"
  260. Command(14) = "List of Objects"
  261. Command(15) = "Move"
  262. Command(16) = "New File"
  263. Command(17) = "Object List"
  264. Command(18) = "Paste"
  265. Command(19) = "Redo"
  266. Command(20) = "Refresh"
  267. Command(21) = "Rendered View"
  268. Command(22) = "Scale"
  269. Command(23) = "Select All"
  270. Command(24) = "Undo"
  271. Command(25) = "Ungroup"
  272. Command(26) = "Zoom Commands"
  273. Command(27) = "Zoom To All"
  274. Command(28) = "Zoom To Selected"
  275. Command(29) = "Zoom Out"
  276. Command(30) = "Zoom Previous"
  277.  
  278.     BEGIN DIALOG DDlistboxdlg 47, 372, 254, 16, "Command List"
  279.         TEXT  4, 4, 90, 8, "&List:"
  280.         DDLISTBOX  23, 2, 138, 106, Command,CmdPicked
  281.         OKBUTTON  170, 1, 40, 15
  282.         CANCELBUTTON  214, 1, 40, 15
  283.     END DIALOG
  284.  
  285.     ret = DIALOG(DDlistboxdlg)
  286.     if ret = 2 then goto LIST
  287.  
  288. WITHOBJECT "CorelCAD.Automation.1"
  289.     SELECT CASE CmdPicked
  290.         CASE 1
  291.             Array
  292.         CASE 2    
  293.             DoChangeColor
  294.         CASE 3
  295.             .FileClose
  296.         CASE 4
  297.             .EditCopy
  298.         CASE 5
  299.             .SolidDefine
  300.         CASE 6
  301.             .DeleteSelection
  302.         CASE 7
  303.             .SelectPointAt 1000,1000,-1,-1
  304.         CASE 8
  305.             Goto LISTOBJ
  306.         CASE 9
  307.             .Duplicate
  308.         CASE 10
  309.             .SolidExplode
  310.         CASE 11
  311.             DoExtrude
  312.         CASE 12
  313.             .Group
  314.         CASE 13
  315.                .Dohide 
  316.         CASE 14
  317.             goto LISTOBJ
  318.         CASE 15
  319.             DoMove
  320.         CASE 16
  321.             .FileNew
  322.         CASE 17
  323.             Goto LISTOBJ
  324.         CASE 18
  325.             DoPaste
  326.         CASE 19
  327.             .redo
  328.         CASE 20
  329.             .wireframe
  330.         CASE 21
  331.             .ShadeEntireView TRUE, TRUE, 1, TRUE
  332.         CASE 22
  333.             DoScale
  334.         CASE 23
  335.             .SelectAll
  336.         CASE 24
  337.             .Undo
  338.         CASE 25
  339.             .Ungroup
  340.         CASE 26
  341.             DoZoom
  342.         CASE 27
  343.             .ZoomToAll
  344.         CASE 28
  345.             .ZoomToSelected
  346.         CASE 29
  347.             .ZoomOut
  348.         CASE 30
  349.             .ZoomPrevious
  350.         CASE else
  351.             Message "Undefined command"
  352.     end SELECT
  353. END WITHOBJECT
  354.  
  355. GOTO LISTCOM
  356. '*************************************************************************************
  357. LISTOBJ:
  358.  
  359. Objects(1) = "ARC"                        'This is the list of Objectss available to be drawn
  360. Objects(2) = "BOX"                        ' (Displayed when user prompts for Objects list)
  361. Objects(3) = "CIRCLE"                    
  362. Objects(4) = "COMMAND LIST"
  363. Objects(5) = "CONE"
  364. Objects(6) = "CYLINDER"
  365. Objects(7) = "ELLIPSE"
  366. Objects(8) = "FRUSTUM"
  367. Objects(9) = "HEMISPHERE"
  368. Objects(10) = "LINE SEGMENTS"
  369. Objects(11)= "POLYGON"
  370. Objects(12) = "POLYLINE"
  371. Objects(13) = "RECTANGLE"
  372. Objects(14) = "SPHERE"
  373. Objects(15) = "TORUS"
  374.  
  375.  
  376.     BEGIN DIALOG ListObBox 47, 372, 254, 16, "Object List"
  377.         TEXT  4, 4, 90, 8, "&List:"
  378.         DDLISTBOX  23, 2, 138, 106, Objects,ObjPicked
  379.         OKBUTTON  170, 1, 40, 15
  380.         CANCELBUTTON  214, 1, 40, 15
  381.     END DIALOG
  382.  
  383. Return = DIALOG(ListObBox)
  384. If Return = 2 then goto LIST
  385.  
  386. WITHOBJECT "CorelCAD.Automation.1"
  387.     SELECT CASE ObjPicked
  388.         CASE 1
  389.             CreateArc
  390.         CASE 2
  391.             CreateBox
  392.         CASE 3
  393.             CreateCircle
  394.         CASE 4
  395.             Goto LISTCOM
  396.         CASE 5
  397.             CreateCone
  398.         CASE 6
  399.             CreateCylinder
  400.         CASE 7
  401.             CreateEllipse
  402.         CASE 8
  403.             CreateFrustum
  404.         CASE 9
  405.             CreateHemisphere
  406.         CASE 10
  407.             CreateLine FALSE
  408.         CASE 11
  409.             CreatePolygon
  410.         CASE 12
  411.             CreateLine TRUE
  412.         CASE 13
  413.             CreateRectangle
  414.         CASE 14
  415.             CreateSphere
  416.         CASE 15
  417.             CreateTorus
  418.         CASE ELSE
  419.             Message "Undefined Command"
  420.     End Select
  421.         
  422. END WITHOBJECT
  423.  
  424. GOTO LISTOBJ
  425. DONEALL:
  426. '*************************************************************************************
  427. '*************************************************************************************
  428. '**************************      DRAWING FUNCTIONS           *************************
  429. '*************************************************************************************
  430. '*************************************************************************************
  431. SUB Array
  432.  
  433. DIM Correct%
  434. DIM TypeArray$
  435. DIM DistanceType$
  436. DIM DoOverall%
  437. DIM ESC%
  438.  
  439. DOARRAY:
  440.     ESC = False
  441.     GetLetter "ARRAY -- Define type","(L)in,(2)D,(3)D,(C)irc,(S)piral,S(p)here","L23CSP",TypeArray$,ESC%
  442.     If ESC = True then GOTO DoneArray            'takes user back to command line
  443.     
  444.     Correct = CBOL(INSTR("L23",TypeArray))
  445.  
  446.     If Correct = true then
  447. StepArray:
  448.         ESC = false
  449.         GetLetter "Distance Mode","(I)ncremental or (O)verall distance ?","IO",DistanceType$,ESC%        
  450.         If ESC = True then GOTO DOARRAY        'takes user back to "array -- define type"
  451.         If DistanceType = "O" then DoOverall = 1
  452.             else DoOverall = 0
  453.     END IF
  454.  
  455.     SELECT CASE TypeArray$
  456.         CASE "L"
  457.             LinearArr DoOverall,ESC 
  458.             If ESC = true then goto StepArray
  459.         CASE "2"
  460.             TwoDArr DoOverall,ESC
  461.             If ESC = true then goto StepArray            
  462.         CASE "3"
  463.             ThreeDArr DoOverall,ESC
  464.             If ESC = true then goto StepArray            
  465.         CASE "C"
  466.             CircleArr ESC 
  467.             If ESC = true then goto DoArray        
  468.         CASE "S"
  469.             SpiralArr ESC 
  470.             If ESC = true then goto DoArray
  471.         CASE "P"
  472.             SphereArr ESC 
  473.             If ESC = true then goto DoArray
  474.         END SELECT
  475.  
  476. DoneArray:
  477. END SUB
  478. '*************************************************************************************
  479. SUB LinearArr (DoOverall%,ESC%)
  480.  
  481. DIM NumCop#
  482. DIM NumCopies%
  483. DIM dX#,dY#,dZ#
  484.  
  485. Lin1:
  486.     GetValue  "LINEAR ARRAY -- # of copies",NumCop#,ESC%
  487.     NumCopies=cint(NumCop)
  488.     If ESC = true then goto Lin2
  489.     GetCoord  "LINEAR ARRAY -- Vector between copies",dX#,dY#,dZ#,ESC%
  490.     If ESC = true then GOTO Lin1
  491.  
  492. WITHOBJECT "CorelCAD.Automation.1"
  493.     .LinearArray DoOverall,NumCopies,0,0,0,dX,dY,dZ
  494. END WITHOBJECT
  495.  
  496. Lin2:
  497. END SUB    'LinearArr    
  498. '*************************************************************************************
  499. SUB TwoDArr (DoOverall%,ESC%)
  500.  
  501. DIM NumCop1#,NumCop2#
  502. DIM NumCopies1&,NumCopies2&
  503. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#
  504.  
  505. TWO1:
  506.     GetValue   "2D ARRAY -- # of copies in 1st direction",NumCop1#,ESC%
  507.     NumCopies1=cint(NumCop1)
  508.     If ESC = true then GOTO TWO4
  509. TWO2:
  510.     GetValue  "2D ARRAY -- # of copies in 2nd direction",NumCop2#,ESC%
  511.     NumCopies2=cint(NumCop2)
  512.     If ESC = true then GOTO TWO1 
  513. TWO3:    
  514.     GetCoord  "2D ARRAY -- Vector between copies (Dir 1)",X1#,Y1#,Z1#,ESC%
  515.     If ESC = true then GOTO TWO2
  516.  
  517.     GetCoord  "2D ARRAY -- Vector between copies (Dir 2)",X2#,Y2#,Z2#,ESC%
  518.      If ESC = true then GOTO TWO3    
  519.  
  520. WITHOBJECT "CorelCAD.Automation.1"
  521.     .TwoDArray DoOverall,NumCopies1,NumCopies2,0,0,0,X1,Y1,Z1,X2,Y2,Z2
  522. END WITHOBJECT
  523.  
  524. TWO4:
  525. END SUB      'TwoDArr
  526. '*************************************************************************************
  527. SUB ThreeDArr (DoOverall%,ESC%)
  528.  
  529. DIM NumCop1#,NumCop2#,NumCop3#
  530. DIM NumCopies1&,NumCopies2&,NumCopies3&
  531. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#
  532.  
  533. THREED1:
  534.     GetValue  "3D ARRAY -- # of copies in 1st direction",NumCop1#,ESC%
  535.     NumCopies1=cint(NumCop1)
  536.     If ESC = true then GOTO THREED6
  537. THREED2:
  538.     GetValue "3D ARRAY -- # of copies in 2nd direction",NumCop2#,ESC%
  539.     NumCopies2=cint(NumCop2)
  540.     If ESC = true then GOTO THREED1 
  541. THREED3:
  542.     GetValue  "3D ARRAY -- # of copies in 3rd direction",NumCop3#,ESC%
  543.     NumCopies3=cint(NumCop3)
  544.     If ESC = true then GOTO THREED2
  545. THREED4:
  546.     GetCoord  "3D ARRAY -- Vector between copies (Dir 1)",X1#,Y1#,Z1#,ESC%
  547.     If ESC = true then GOTO THREED3
  548. THREED5:
  549.     GetCoord  "3D ARRAY -- Vector between copies (Dir 2)",X2#,Y2#,Z2#,ESC%
  550.     If ESC = true then GOTO THREED4
  551.  
  552.     GetCoord  "3D ARRAY -- Vector between copies (Dir 3)",X3#,Y3#,Z3#,ESC%
  553.      If ESC = true then GOTO THREED5
  554.     
  555.  
  556. WITHOBJECT "CorelCAD.Automation.1"
  557.     .ThreeDArray DoOverall,NumCopies1,NumCopies2,NumCopies3,0,0,0,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
  558. END WITHOBJECT
  559.  
  560. THREED6:
  561. END SUB    'ThreeDArr
  562. '*************************************************************************************
  563. SUB CircleArr(ESC%)
  564.  
  565. DIM NumCop#
  566. DIM NumCopies%
  567. DIM RotateLet$
  568. DIM Rotate%
  569. DIM Angle#
  570.  
  571.     Rotate% = 0
  572. CIR1:
  573.     GetLetter "CIRCULAR ARRAY -- PROPERTIES","Rotate Objects ? (Y) or (N): ","YN",RotateLet$,ESC%
  574.     If ESC = True then goto CIR8
  575. CIR2:
  576.     GetValue "CIRCULAR ARRAY -- # of copies  ",NumCop#,ESC%
  577.     NumCopies=CINT(NumCop)
  578.     If ESC = True then goto CIR1
  579. CIR3:
  580.     GetValue "CIRCULAR ARRAY -- Angle of rotation",Angle#,ESC%
  581.     If ESC = True then goto CIR2
  582. WITHOBJECT "CorelCAD.Automation.1"
  583.     If RotateLet="Y" then
  584.         Rotate=-1
  585. CIR4:
  586.         GetCoord  "CIRCULAR ARRAY -- Start Point of Axis of rotation",X1#,Y1#,Z1#,ESC%
  587.     If ESC = True then goto CIR3
  588.         x2=x1
  589.         y2=y1
  590.         z2=z1
  591. CIR5:
  592.         GetCoord  "CIRCULAR ARRAY -- End Point of Axis of rotation",X2#,Y2#,Z2#,ESC%
  593.     If ESC = True then goto CIR4
  594.         .CircularArray NumCopies%,Angle#,Rotate%,X1,y1,z1,x2,y2,z2
  595.     else
  596.         Rotate=0
  597. CIR6:
  598.         GetCoord  "CIRCULAR ARRAY --Base Point for rotation",X1#,Y1#,Z1#,ESC%
  599.     If ESC = True then goto CIR3
  600.         x2=x1
  601.         y2=y1
  602.         z2=z1
  603. CIR7:
  604.         GetCoord  "CIRCULAR ARRAY -- Start Point of Axis of rotation",X2#,y2#,Z2#,ESC%
  605.     If ESC = True then goto CIR6
  606.         x3=x2
  607.         y3=y2
  608.         z3=z2
  609.  
  610.         GetCoord "CIRCULAR ARRAY -- End Point of Axis of rotation",X3#,Y3#,Z3#,ESC%
  611.     If ESC = True then goto CIR7
  612.         .CircularArray NumCopies%,Angle#,Rotate%,X1,y1,z1,x2,y2,z2,x3,y3,z3
  613.     END IF
  614. END WITHOBJECT
  615.  
  616. CIR8:
  617. END SUB    'CircleArr
  618. '*************************************************************************************
  619. SUB SpiralArr(ESC%)
  620.  
  621. DIM NumCop#
  622. DIM NumCopies%
  623. DIM RotateLet$
  624. DIM Rotate%
  625. DIM Angle#
  626. DIM Offset#
  627. DIM x1#,y1#,z1#,x2#,y2#,z2#,x3#,y3#,z3#
  628.  
  629.     Rotate% = 0
  630. SPI1:
  631.     GetLetter "SPIRAL ARRAY -- PROPERTIES","Rotate Objects ? (Y) or (N): ","YN",RotateLet$,ESC%
  632.     If ESC = True then goto SPI9
  633. SPI2:
  634.     GetValue "SPIRAL ARRAY -- # of copies  ",NumCop#,ESC%
  635.     NumCopies=CINT(NumCop)
  636.     If ESC = True then goto SPI1
  637. SPI3:
  638.     GetValue  "SPIRAL ARRAY -- Angle of rotation",Angle#,ESC%
  639.     If ESC = True then goto SPI2
  640.     Angle#=Angle/360
  641. SPI4:
  642.     GetValue "SPIRAL ARRAY -- Magnitude of offset",Offset#,ESC%
  643.     If ESC = True then goto SPI3
  644.  
  645. WITHOBJECT "CorelCAD.Automation.1"
  646.     If RotateLet="Y" then
  647.         Rotate=-1
  648. SPI5:
  649.         GetCoord  "SPIRAL ARRAY -- First Point of Axis of rotation",X1#,Y1#,Z1#,ESC%
  650.     If ESC = True then goto SPI4
  651.         x2#=x1#
  652.         y2#=y1#
  653.         z2#=z1#
  654. SPI6:
  655.         GetCoord  "SPIRAL ARRAY -- End Point of Axis of rotation",X2#,Y2#,Z2#,ESC%
  656.     If ESC = True then goto SPI5
  657.         .SpiralArray NumCopies%,Angle#,Offset#,Rotate%,X1,y1,z1,x2,y2,z2
  658.     else
  659.         Rotate=0
  660. SPI7:
  661.         GetCoord  "SPIRAL ARRAY -- Base Point for rotation",X1#,Y1#,Z1#,ESC%
  662.     If ESC = True then goto SPI4
  663.         x2=x1
  664.         y2=y1
  665.         z2=z1
  666. SPI8:
  667.         GetCoord "SPIRAL ARRAY -- Start Point of Axis of rotation",X2#,y2#,Z2#,ESC%
  668.     If ESC = True then goto SPI5
  669.         x3=x2
  670.         y3=y2
  671.         z3=z2
  672.  
  673.         GetCoord "SPIRAL ARRAY -- End Point of Axis of rotation",X3#,Y3#,Z3#,ESC%
  674.          If ESC = True then goto SPI6
  675.         .SpiralArray NumCopies%,Angle#,Offset#,Rotate%,X1,y1,z1,x2,y2,z2,x3,y3,z3
  676.     END IF
  677. END WITHOBJECT
  678.  
  679. SPI9:
  680. END SUB    'SpiralArr
  681. '*************************************************************************************
  682. SUB SphereArr(ESC%)
  683.     
  684. DIM Numeq#, Numpo#,Row#
  685. DIM Numequator%,Numpoles%,Rows%
  686. DIM Rotateobject$
  687. DIM Rotate%
  688.  
  689. DIM x1#,y1#,z1#,x2#,y2#,z2#,x3#,y3#,z3#
  690.  
  691.     Rotate% = 0
  692. SPH1:
  693.     GetLetter "SPhereARRAY -- PROPERTIES","Rotate Objects ? (Y) or (N): ","YN",RotateLet$,ESC%
  694.     If ESC = True then goto SPH9
  695. SPH2:
  696.     GetValue "SPere ARRAY -- # of copies  in equator ",Numeq#,ESC%
  697.     Numequator=CINT(Numeq)
  698.     If ESC = True then goto SPH1
  699. SPH3:
  700.     GetValue  "SPere ARRAY -- # of copies in poles",Numpo#,ESC%
  701.     Numpoles=CINT(Numpo)
  702.      If ESC = True then goto SPH2
  703.     
  704. SPH4:
  705.     GetValue "SPere ARRAY -- # of rows",Row#,ESC%
  706.      Rows=CINT(Row) 
  707.      If ESC = True then goto SPH3
  708.  
  709. WITHOBJECT "CorelCAD.Automation.1"
  710.     If RotateLet="Y" then
  711.         Rotate=-1
  712. SPH5:
  713.         GetCoord  "Spere ARRAY -- First Point of Axis of rotation",X1#,Y1#,Z1#,ESC%
  714.          If ESC = True then goto SPH4
  715.         x2#=x1#
  716.         y2#=y1#
  717.         z2#=z1#
  718. SPH6:
  719.         GetCoord  "SPere ARRAY -- End Point of Axis of rotation",X2#,Y2#,Z2#,ESC%
  720.          If ESC = True then goto SPH5
  721.           GetCoord  "SPere ARRAY -- End Point of Axis of rotation",X3#,Y3#,Z3#,ESC%
  722.         .SphericalArray  Numequator%,numpoles,rows,Rotate%,X1,y1,z1,x2,y2,z2,X3,Y3,Z3
  723.     else
  724.         Rotate=0
  725. SPH7:
  726.         GetCoord  "SPere ARRAY -- Base Point for rotation",X1#,Y1#,Z1#,ESC%
  727.     If ESC = True then goto SPH4
  728.         x2=x1
  729.         y2=y1
  730.         z2=z1
  731. SPH8:
  732.         GetCoord "SPere ARRAY -- Start Point of Axis of rotation",X2#,y2#,Z2#,ESC%
  733.     If ESC = True then goto SPH5
  734.         x3=x2
  735.         y3=y2
  736.         z3=z2
  737.  
  738.         GetCoord "SPere ARRAY -- End Point of Axis of rotation",X3#,Y3#,Z3#,ESC%
  739.          If ESC = True then goto SPh6
  740.      .SphericalArray  Numequator%,numpoles,rows,Rotate%,X1,y1,z1,x2,y2,z2,X3,Y3,Z3    
  741.     END IF
  742. END WITHOBJECT
  743.  
  744. SPH9:
  745. END SUB    'SphereArr
  746.  
  747. '*************************************************************************************
  748. '***************************       START ARCS     ************************************
  749. '*************************************************************************************
  750. SUB CreateArc
  751.  
  752. DIM Wireflag%
  753. DIM ArcType$
  754.  
  755. ARC1:
  756.     GetLetter "ARC -- Options","(W)ire, (C)enter, (E)ndpoint:","WCE",ArcType$,ESC%
  757.     If ESC = True then goto ARC2
  758.  
  759.     SELECT CASE ArcType$
  760.         CASE "W"
  761.             WireFlag% = 0        
  762.         CASE "C"
  763.             WireFlag% = 1
  764.         CASE "E"
  765.             WireFlag% = 2    
  766.     END SELECT
  767.  
  768.  
  769. DiaAr:
  770.  
  771.     TypeArc = "3"
  772.     BEGIN DIALOG DiaArc 47, 372, 254, 16, "ARC -- Define your Arc"
  773.         TEXT  0, 4, 197, 12, "(3)Pt,(A)ngle,(C)tr,(R)adius,(E)llipse:"
  774.         TEXTBOX  111, 2, 55, 13, TypeArc$
  775.         OKBUTTON  170, 1, 40, 15
  776.         CANCELBUTTON  214, 1, 40, 15
  777.     END DIALOG
  778.  
  779.     ret= DIALOG(DiaArc)
  780.     if ret = 2 then goto ARC1
  781.     TypeArc$=UCASE(TypeArc$)
  782.  
  783.     SELECT CASE TypeArc$
  784.         CASE "3"
  785.                 CreateArc3Points Wireflag%,ESC%
  786.         CASE "A"
  787.                 CreateArcAngle Wireflag%,ESC%
  788.         CASE "C"
  789.                 CreateArcCSE Wireflag%,ESC%
  790.         CASE "E"
  791.                 CreateArcEllipses Wireflag%,ESC%
  792.         CASE "R"
  793.                 CreateArcRSE Wireflag%,ESC%
  794.         CASE else
  795.                 Message "Sorry, not a correct entry. Pick an character in brackets "
  796.                 goto DiaAr    
  797.     END SELECT
  798. '     --  --  --  --  -- -        
  799.  
  800. ARC2:
  801. END SUB
  802.  
  803. '*************************************************************************************
  804. SUB CreateArc3Points (Wireflag%,ESC%)
  805.  
  806. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#
  807.   ARC31:
  808.      ESC=false  
  809.     GetCoord  "ARC -- Pick start point",X1#,Y1#,Z1#,ESC%
  810.      if ESC=true then goto ARC33 
  811.     x2=x1
  812.     y2=y1
  813.     z2=z1
  814. ARC32: 
  815.      ESC=false
  816.      GetCoord  "ARC -- Pick 2nd point",X2#,Y2#,Z2#,ESC%
  817.      if ESC=true then goto ARC31
  818.     x3=x2
  819.     y3=y2
  820.     z3=z2
  821.  
  822.      ESC=false
  823.     GetCoord  "ARC -- Pick end point",X3#,Y3#,Z3#,ESC%
  824.       if ESC=true then goto ARC32
  825. WITHOBJECT "CorelCAD.Automation.1"
  826.     .Arc3Points WireFlag, X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
  827. END WITHOBJECT
  828. ARC33:
  829. END SUB 'CreateArc3Points
  830. '*************************************************************************************
  831. SUB CreateArcAngle (WireFlag%,ESC%)
  832.  
  833. DIM Angle#    
  834. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#
  835.  ARCANGLE1:
  836.      ESC=false
  837.     GetValue  "ARC -- Enter the Arc Angle",Angle#,ESC%
  838.      if ESC=true then goto ARCANGLE3 
  839. ARCANGLE2:
  840.      ESC=false 
  841.      GetCoord  "ARC -- Pick start point", X1#, Y1#, Z1#,ESC%
  842.     if ESC=true then goto ARCANGLE1
  843.      x2=x1
  844.     y2=y1
  845.     z2=z1
  846.  
  847.      ESC=false
  848.       GetCoord "ARC -- Pick end point", X2#, Y2#, Z2#,ESC%
  849.      if ESC=true then goto ARCANGLE2
  850.  
  851. WITHOBJECT "CorelCAD.Automation.1"
  852.     .ArcAngle WireFlag, Angle, X1, Y1, Z1, X2, Y2, Z2
  853. END WITHOBJECT
  854. ARCANGLE3:
  855. END SUB 'CreateArcAngle
  856. '*************************************************************************************
  857. SUB CreateArcCSE (WireFlag%,ESC%)
  858.  
  859.     DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#
  860. ARCCSE1:
  861.      ESC=false
  862.       GetCoord  "ARC -- Pick center of the arc",X1#,Y1#,Z1#,ESC%
  863.      if ESC=true then goto ARCCSE3
  864.     x2=x1
  865.     y2=y1
  866.     y2=y1
  867. ARCCSE2:
  868.      ESC=false 
  869.      GetCoord  "ARC -- Pick start point",X2#,Y2#,Z2#,ESC%
  870.       if ESC=true then goto ARCCSE1
  871.     x3=x2
  872.     y3=y2
  873.     z3=z2
  874.  
  875.      ESC=false
  876.     GetCoord "ARC -- Pick end point",X3#,Y3#,Z3#,ESC%
  877.       if ESC=true then goto ARCCSE2
  878. WITHOBJECT "CorelCAD.Automation.1"
  879.     .ArcCSE WireFlag, X1, Y1, Z1, X2, Y2, Z2, X3, Y3, Z3
  880. END WITHOBJECT
  881. ARCCSE3:
  882.      
  883. END SUB 'CreateArcCSE
  884. '*************************************************************************************
  885. SUB CreateArcEllipses (WireFlag%,ESC%)
  886.  
  887. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,X4#,Y4#,Z4#,X5#,Y5#,Z5#
  888. ARCELLIPSE1:
  889.      ESC=false
  890.       GetCoord "ARC -- Pick center of ellipse",X1#,Y1#,Z1#,ESC%
  891.      if ESC=true then goto ARCELLIPSE5
  892.      ESC=false
  893.     x2=x1
  894.     y2=y1
  895.     z2=y1
  896. ARCELLIPSE2:
  897.      ESC=false 
  898.      GetCoord "ARC -- Pick 2nd point (defines major axis)",X2#,Y2#,Z2#,ESC%
  899.       if ESC=true then goto ARCELLIPSE1
  900.     x3=x2
  901.     y3=y2
  902.     z3=y2
  903. ARCELLIPSE3:
  904.      ESC=false
  905.     GetCoord  "ARC -- Pick 3rd point (defines minor axis)",X3#,Y3#,Z3#,ESC%
  906.       if ESC=true then goto ARCELLIPSE2
  907.     x4=x3
  908.     y4=y3
  909.     z4=y3
  910. ARCELLIPSE4:
  911.      ESC=false
  912.       GetCoord "ARC -- Pick 4th point (defines start angle)",X4#,Y4#,Z4#,ESC%
  913.       if ESC=true then goto ARCELLIPSE3 
  914.     x5=x4
  915.     y5=y4
  916.     z5=y4
  917.  
  918.      ESC=false
  919.     GetCoord "ARC -- Pick 5th point (defines stop angle)",X5#,Y5#,Z5#,ESC%
  920.       if ESC=true then goto ARCELLIPSE4
  921. WITHOBJECT "CorelCAD.Automation.1"
  922.     .ArcEllipse WireFlag, X1, Y1, Z1, X1+X2, Y1+Y2, Z1+Z2, X1+X3, Y1+Y3, Z1+Z3, X4, Y4, Z4, X5, Y5, Z5
  923. END WITHOBJECT
  924. ARCELLIPSE5:
  925.      
  926. END SUB 'CreateArcEllipses
  927. '*************************************************************************************
  928. SUB CreateArcRSE (WireFlag%,ESC%)
  929.  
  930. DIM RAD as double
  931. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#
  932. ARCRSE1:
  933.      ESC=false
  934.     GetValue "ARC -- Enter the radius of the arc",Rad#,ESC%
  935.      if ESC=true then goto ARCRSE4
  936. ARCRSE2:
  937.      ESC=false 
  938.      GetCoord "ARC -- Pick start point",X1#,Y1#,Z1#,ESC%
  939.      if ESC=true then goto ARCRSE1
  940.     x2=x1
  941.     y2=y1
  942.     z2=y1
  943. ARCRSE3:
  944.      ESC=false
  945.     GetCoord "ARC -- Pick 2nd point",X2#,Y2#,Z2#,ESC%
  946.      if ESC=true then goto ARCRSE2
  947.     x3=x2
  948.     y3=y2
  949.     z3=y2
  950.  
  951.      ESC=false
  952.     GetCoord "ARC -- Pick end point",X3#,Y3#,Z3#,ESC%
  953.      if ESC=true then goto ARCRSE3
  954. WITHOBJECT "CorelCAD.Automation.1"
  955.     .ArcRSE WireFlag, RAD, X1, Y1, Z1, X2, Y2, Z2, X3, Y3, Z3
  956. END WITHOBJECT
  957. ARCRSE4:
  958.      
  959. END SUB 'CreateArcRSE
  960. '*************************************************************************************
  961. '*************************      END   ARCS     ***************************************
  962. '*************************************************************************************
  963. SUB CreateBox
  964.  
  965.  
  966. DIM X1#,Y1#,Z1#,dX#,dY#,dZ#,ESC%
  967. DIM SolidLet$
  968. DIM WireFlag%
  969. BOX1:
  970.    ESC=false    
  971.     GetLetter "BOX -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  972.      if ESC=true then goto BOX5
  973.     SELECT CASE SolidLet$
  974.         CASE "U"
  975.             WireFlag% = 0        
  976.         CASE "S"
  977.             WireFlag% = 1
  978.     END SELECT
  979. BOX2:
  980.      ESC=false
  981.     GetCoord "BOX -- Pick start point",X1#,Y1#,Z1#,ESC%
  982.       if ESC=true then goto BOX1
  983. BOX3:
  984.     ESC=false
  985.    
  986.     GetValue "BOX -- Enter the width (X-Direction)",dX,ESC%
  987.       if ESC=true then goto BOX2
  988. BOX4:
  989.      ESC=false
  990.     GetValue "BOX -- Enter the length (Y-Direction)",dY,ESC%
  991.       if ESC=true then goto BOX3
  992.  
  993.      GetValue "BOX -- Enter the height (Z-Direction)",dZ,ESC%
  994.       if ESC=true then goto BOX4
  995. WITHOBJECT "CorelCAD.Automation.1"
  996.     .box WireFlag, X1,Y1,Z1,X1+dX,Y1+DY,Z1+dZ
  997. END WITHOBJECT 
  998. BOX5:
  999. donebox: 
  1000. END SUB 'CreateBox
  1001. '*************************************************************************************
  1002. '*************************    START CIRCLES     **************************************
  1003. '*************************************************************************************
  1004. SUB CreateCircle
  1005.  
  1006.  
  1007. DIM WireFlag%
  1008. DIM CircType$
  1009. DIM TypeCircle$
  1010. DIM ESC%
  1011. CIRCLE1:
  1012.      ESC=false     
  1013.     GetLetter "CIRCLE -- Options","(W)ireframe, (S)urface:","WS", CircType$,ESC%
  1014.      if ESC=true then goto CIRCLE2
  1015.     SELECT CASE CircType$
  1016.         CASE "W"
  1017.             WireFlag% = 0        
  1018.         CASE "S","s"
  1019.             WireFlag% = 1
  1020.     END SELECT
  1021.  
  1022.           
  1023.     GetLetter "CIRCLE -- Type","(C)enter,(2)Point,(3)Point: ","C23",TypeCircle$,ESC%
  1024.      if ESC=true then goto CIRCLE1
  1025.     SELECT CASE TypeCircle$
  1026.         CASE "C"
  1027.                 CreateCircleRadius WireFlag%,ESC%
  1028.                 If ESC = TRUE then Goto CIRCLE2    
  1029.         CASE "2"
  1030.                 CreateCircleDiameter WireFlag%,ESC%
  1031.                 If ESC = TRUE then Goto CIRCLE2                        
  1032.         CASE "3"
  1033.                 CreateCircle3Point WireFlag%,ESC%
  1034.                 If ESC = TRUE then Goto CIRCLE2    
  1035.     END SELECT
  1036. CIRCLE2:
  1037.      
  1038. END SUB
  1039. '*************************************************************************************
  1040. SUB CreateCircle3Point(WireFlag%,ESC%)
  1041.  
  1042. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#
  1043. CIRCLE31:
  1044.      ESC=false
  1045.       GetCoord  "CIRCLE -- Pick 1st point",X1#,Y1#,Z1#,ESC%
  1046.      if ESC=true then goto CIRCLE33
  1047.     x2=x1
  1048.     y2=y1
  1049.     z2=y1
  1050. CIRCLE32:
  1051.      ESC=false
  1052.       GetCoord "CIRCLE -- Pick 2nd point",X2#,Y2#,Z2#,ESC%
  1053.        if ESC=true then goto CIRCLE31
  1054.     x3=x2
  1055.     y3=y2
  1056.     z3=y2
  1057.  
  1058.  
  1059.      ESC=false
  1060.     GetCoord "CIRCLE -- Pick 3rd point",X3#,Y3#,Z3#,ESC%
  1061.        if ESC=true then goto CIRCLE32
  1062. WITHOBJECT "CorelCAD.Automation.1"
  1063.     .Circle3Points WireFlag, X1, Y1, Z1, X2, Y2, Z2, X3, Y3, Z3
  1064. END WITHOBJECT
  1065. CIRCLE33:
  1066.      
  1067. END SUB 'CreateCircle3Point
  1068. '*************************************************************************************
  1069. SUB CreateCircleDiameter(WireFlag%,ESC%)
  1070.  
  1071. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#
  1072. CIRCLED1:
  1073.      ESC=false
  1074.       GetCoord  "CIRCLE -- Pick 1st point", X#, Y#, Z#,ESC%
  1075.      if ESC=true then goto CIRCLED2
  1076.      X2=x
  1077.     Y2=y
  1078.     Z2=z
  1079.  
  1080.      ESC=false 
  1081.      GetCoord "CIRCLE -- Pick 2nd point (defines diameter)", X2#, Y2#, Z2#,ESC%
  1082.      if ESC=true then goto CIRCLED1
  1083.  
  1084. WITHOBJECT "CorelCAD.Automation.1"
  1085.     .CircleDiameter  WireFlag, X1, Y1, Z1, X2, Y2, Z2
  1086. END WITHOBJECT
  1087. CIRCLED2:
  1088.      
  1089. END SUB 'CreateCircleDiameter
  1090. '*************************************************************************************
  1091. SUB CreateCircleRadius(WireFlag%,ESC%)                    ' THIS FUNCTION ASSUMES THE USER WANTS A CIRCLE IN THE
  1092.                                             ' X-Y PLANE, AND HE IS NOT ABLE TO DRAW ONE WITH ANY
  1093. DIM X1#,Y1#,Z1#                                ' DIMENSION IN THE Z DIRECTION (this is easily changed if desired)
  1094. DIM dX as double        'this could be changed to declare x2, y2, z2                            
  1095. CircleRadius1:
  1096.      ESC=false                
  1097.       GetCoord "CIRCLE -- Pick center of the circle",X1#,Y1#,Z1#,ESC%
  1098.      if ESC=true then goto CircleRadius2
  1099.  
  1100.      ESC=false    
  1101.     GetValue  "CIRCLE -- Enter the radius",dX,ESC%                    'this could be changed to pick point (x2,y2,z2)
  1102.        if ESC=true then goto CircleRadius1
  1103.  
  1104. WITHOBJECT "CorelCAD.Automation.1"
  1105.     .CircleRadius  WireFlag, X1,Y1,Z1,X1+dX,Y1,Z1
  1106. END WITHOBJECT
  1107. CircleRadius2:
  1108.      
  1109. END SUB 'CreateCircleRadius
  1110. '*************************************************************************************
  1111. '**************************     END CIRCLES   ****************************************
  1112. '*************************************************************************************
  1113. SUB CreateCone
  1114.  
  1115. DIM X1#,Y1#,Z1#,ESC%
  1116. DIM dX#      'for the radius
  1117. DIM dZ#    'for the height
  1118. DIM SolidLet$
  1119. DIM WireFlag%
  1120. CONE1:
  1121.      ESC=false    
  1122.     GetLetter "CONE -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1123.      if ESC=true then goto CONE4
  1124.     SELECT CASE SolidLet$
  1125.         CASE "U"
  1126.             WireFlag% = 0        
  1127.         CASE "S"
  1128.             WireFlag% = 1
  1129.     END SELECT
  1130. CONE2:
  1131.      ESC=false
  1132.     GetCoord  "CONE -- Pick center of the face",X1#,Y1#,Z1#,ESC%
  1133.       if ESC=true then goto CONE1
  1134. CONE3:
  1135.      ESC=false
  1136.     GetValue "CONE -- Enter the radius of the face", dX#,ESC%            'assumes face is in the x-y plane
  1137.       if ESC=true then goto CONE2
  1138.  
  1139.      ESC=false
  1140.     GetValue "CONE -- Enter the height of the cone",dZ#,ESC%        'assumes height is along z-axis
  1141.       if ESC=true then goto CONE3
  1142. WITHOBJECT "CorelCAD.Automation.1"
  1143.     .Cone WireFlag,X1,Y1,Z1,X1+dX,Y1,Z1,X1,Y1,Z1+dZ
  1144. END WITHOBJECT
  1145. CONE4:
  1146. END SUB 'CreateCones
  1147. '*************************************************************************************
  1148. SUB CreateCylinder
  1149.  
  1150. DIM X1#,Y1#,Z1#,ESC%
  1151. DIM dX#      'for the radius
  1152. DIM dZ#    'for the height
  1153. DIM SolidLet$
  1154. DIM WireFlag%
  1155.  
  1156. CYLINDER1:
  1157.      ESC=false
  1158.     GetLetter "CYLINDER -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1159.      if ESC=true then goto CYLINDER4
  1160.     SELECT CASE SolidLet$
  1161.         CASE "U"
  1162.             WireFlag% = 0        
  1163.         CASE "S"
  1164.             WireFlag% = 1
  1165.     END SELECT
  1166. CYLINDER2:
  1167.      ESC=false
  1168.     GetCoord  "CYLINDER -- Pick center of the face",X1#,Y1#,Z1#,ESC%
  1169.      if ESC=true then goto CYLINDER1
  1170. CYLINDER3:
  1171.      ESC=false
  1172.     GetValue "CYLINDER -- Enter the radius of the face", dX#,ESC%            'assumes face is in the x-y plane
  1173.      if ESC=true then goto CYLINDER2
  1174.  
  1175.      ESC=false
  1176.        GetValue  "CYLINDER -- Enter the height of the cylinder",dZ#,ESC%        'assumes height is along z-axis
  1177.      if ESC=true then goto CYLINDER3 
  1178. WITHOBJECT "CorelCAD.Automation.1"
  1179.     .Cylinder WireFlag,X1,Y1,Z1,X1+dX,Y1,Z1,X1,Y1,Z1+dZ
  1180. END WITHOBJECT
  1181. CYLINDER4:
  1182.      
  1183. END SUB 'CreateCylinder
  1184. '*************************************************************************************
  1185. SUB CreateEllipse
  1186.     
  1187. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,ESC%
  1188. DIM EllType$
  1189. ELLIPSE1:
  1190.      ESC=false
  1191.        GetLetter "ELLIPSE -- Options","(W)ireframe, (S)urface:","WS", EllType$,ESC%
  1192.      if ESC=true then goto ELLIPSE4
  1193.     SELECT CASE EllType$
  1194.         CASE "W"
  1195.             WireFlag% = 0        
  1196.         CASE "S","s"
  1197.             WireFlag% = 1
  1198.     END SELECT
  1199.  
  1200. ELLIPSE2:
  1201.      ESC=false    
  1202.      GetCoord "ELLIPSE -- Pick center",X1#,Y1#,Z1#,ESC%
  1203.      if ESC=false then goto ELLIPSE1 
  1204.      x2=x1
  1205.     y2=y1
  1206.     z2=y1
  1207. ELLIPSE3:
  1208.      ESC=false
  1209.     GetCoord  "ELLIPSE -- Pick 2nd point (defines major axis)",X2#,Y2#,Z2#,ESC%
  1210.       if ESC=false then goto ELLIPSE2 
  1211.     x3=x2
  1212.     y3=y2
  1213.     z3=y2
  1214.  
  1215.      ESC=false
  1216.     GetCoord  "ELLIPSE -- Pick 3rd point (defines minor axis)",X3#,Y3#,Z3#,ESC%
  1217.       if ESC=false then goto ELLIPSE3
  1218. WITHOBJECT "CorelCAD.Automation.1"
  1219.     .Ellipse WireFlag,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
  1220. END WITHOBJECT
  1221. ELLIPSE4:
  1222. donell: 
  1223. END SUB 'CreateEllipse
  1224. '*************************************************************************************
  1225. SUB CreateFrustum
  1226.  
  1227. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,X4#,Y4#,Z4#,X5#,Y5#,Z5#,ESC%
  1228. DIM SolidLet$
  1229. DIM WireFlag%
  1230. FRUSTUM1:
  1231.      ESC=false
  1232.     GetLetter "FRUSTUM -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1233.      if ESC=true then goto FRUSTUM6
  1234.     SELECT CASE SolidLet$
  1235.         CASE "U"
  1236.             WireFlag% = 0        
  1237.         CASE "S"
  1238.             WireFlag% = 1
  1239.     END SELECT
  1240. FRUSTUM2:
  1241.      ESC=false
  1242.     GetCoord  "FRUSTUM -- Pick center of the base",X1#,Y1#,Z1#,ESC%
  1243.      if ESC=true then goto FRUSTUM1
  1244.     x2=x1
  1245.     y2=y1
  1246.     z2=y1
  1247. FRUSTUM3:
  1248.      ESC=false
  1249.     GetCoord  "FRUSTUM -- Pick 2nd point (defines radius of base)",X2#,Y2#,Z2#,ESC%
  1250.     if ESC=true then goto FRUSTUM2
  1251.      x3=x2
  1252.     y3=y2
  1253.     z3=y2
  1254. FRUSTUM4:
  1255.      ESC=false
  1256.     GetCoord "FRUSTUM -- Pick 3rd point (defines center of second face)",X3#,Y3#,Z3#,ESC%
  1257.     if ESC=true then goto FRUSTUM3
  1258.      x4=x3
  1259.     y4=y3
  1260.     z4=y3
  1261. FRUSTUM5:
  1262.      ESC=false
  1263.     GetCoord  "FRUSTUM -- Pick 4th point (defines radius of second face)",X4#,Y4#,Z4#,ESC%
  1264.     if ESC=true then goto FRUSTUM4
  1265.      x5=x4
  1266.     y5=y4
  1267.     z5=y4
  1268.  
  1269.      ESC=false
  1270.     
  1271. WITHOBJECT "CorelCAD.Automation.1"
  1272.     .Frustum WireFlag,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,X4,Y4,Z4
  1273. END WITHOBJECT
  1274. FRUSTUM6:
  1275.      
  1276.  
  1277. END SUB 'CreateFrustum
  1278. '*************************************************************************************
  1279. SUB CreateHemisphere
  1280.  
  1281. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,ESC%
  1282. DIM SolidLet$
  1283. DIM WireFlag%
  1284. HEMISPHERE1:
  1285.      ESC=false    
  1286.     GetLetter "HEMISPHERE -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1287.      if ESC=true then goto Hemisphere4    
  1288.     SELECT CASE SolidLet$
  1289.         CASE "U"
  1290.             WireFlag% = 0        
  1291.         CASE "S"
  1292.             WireFlag% = 1
  1293.     END SELECT
  1294. HEMISPHERE2:
  1295.      ESC=false    
  1296.     GetCoord  "HEMISPHERE -- Pick center of the face",X1#,Y1#,Z1#,ESC%
  1297.      if ESC=true then goto HEMISPHERE1 
  1298.     x2=x1
  1299.     y2=y1
  1300.     z2=y1
  1301. HEMISPHERE3:
  1302.      ESC=false    
  1303.     GetCoord  "HEMISPHERE -- Pick 2nd point (defines radius)",X2#,Y2#,Z2#,ESC%
  1304.     if ESC=true then goto HEMISPHERE2
  1305.      x3=x2
  1306.     y3=y2
  1307.     z3=y2
  1308.  
  1309.      ESC=false    
  1310.     GetCoord  "HEMISPHERE -- Pick 3rd point (defines direction of bowl)",X3#,Y3#,Z3#,ESC%
  1311.      if ESC=true then goto HEMISPHERE3
  1312. WITHOBJECT "CorelCAD.Automation.1"
  1313.     .HemiSphere WireFlag,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
  1314. END WITHOBJECT
  1315. HEMISPHERE4:
  1316.      
  1317. donehem: 
  1318. END SUB 'CreateHemisphere
  1319. '*************************************************************************************
  1320. SUB CreateLine (PolyFlag%)
  1321.  
  1322. DIM i%                'counter
  1323. DIM NumPoints%
  1324. DIM StrArray$(10)
  1325. DIM x#,y#,z#,ESC%
  1326. DIM Points#(100,3)
  1327. DIM EntryStr$
  1328.  
  1329.     EntryStr$= "POLYLINE -- Pick starting point"
  1330.     If (PolyFlag%=FALSE) then EntryStr$= "LINE SEGMENTS -- Pick starting point"
  1331.  
  1332.     GetCoord  EntryStr$, x#,y#,z#,ESC%
  1333.     If ESC = TRUE then Goto AllDone
  1334.  
  1335.     Points#(1,1)= x
  1336.     Points#(1,2)= y
  1337.     Points#(1,3)= z
  1338.  
  1339.     FOR i%=2 to 100
  1340.         oops:
  1341.         temp$=LTRIM(str(i))    
  1342.  
  1343.      ESC=false
  1344.         GetCoord  temp$, x#, y#, z#,ESC%
  1345.  
  1346.         IF temp$="C" then
  1347.             Points#(i,1)=Points#(1,1)
  1348.             Points#(i,2)=Points#(1,2)
  1349.             Points#(i,3)=Points#(1,3)
  1350.             goto DoneFor
  1351.         ELSEIF temp$="D" then
  1352.             i%=i-1
  1353.             goto DoneFor
  1354.         ELSEIF temp$="E" then
  1355.             goto Edit
  1356.         ELSE
  1357.             Points#(i,1)=x
  1358.             Points#(i,2)=y
  1359.             Points#(i,3)=z
  1360.         ENDIF
  1361.     NEXT I%
  1362.  
  1363. DoneFor:
  1364.  
  1365. WITHOBJECT "CorelCad.Automation.1"
  1366.     NumPoints%=i%
  1367.     FOR i%=1 to NumPoints
  1368.         .SetPointXYZ Points#(i,1), Points#(i,2), Points#(i,3)
  1369.     NEXT i%
  1370.     IF (PolyFlag = TRUE) THEN
  1371.             .PolyLine
  1372.         ELSE
  1373.             .LineSegment
  1374.     ENDIF
  1375.     goto alldone    
  1376. END WITHOBJECT
  1377.  
  1378. EDIT:
  1379.     NumPoints%=i-1
  1380.     
  1381.     FOR i%=1 to NumPoints
  1382.         x#=Points(i,1)
  1383.         y#=Points(i,2)
  1384.         z#=Points(i,3)
  1385.         StrArray$(i)= str(i)+")    ("+str(x)+","+str(y)+","+str(z)+")"
  1386.     NEXT i%
  1387.  
  1388.     BoxL%=10*NumPoints+4        'defines the length of the list box
  1389.     DiaL%=10*NumPoints+40        'defines the length of the dialogue box
  1390.  
  1391.     Default%= NumPoints
  1392.     BEGIN DIALOG EDSTR 123, DiaL, "Edit a point"
  1393.         TEXT  2, 22, 82, 9, "Pick point to edit:"
  1394.         LISTBOX  28, 36, 65, BoxL, StrArray$, Default%
  1395.         OKBUTTON  51, 4, 35, 14
  1396.         CANCELBUTTON  88, 4, 35, 14
  1397.     END DIALOG
  1398.  
  1399.     ret= DIALOG(EDSTR)
  1400.     if ret=2 then goto oops
  1401.  
  1402.     X#=Points(Default,1)
  1403.     Y#=Points(Default,2)
  1404.     Z#=Points(Default,3)
  1405.  
  1406.     GetCoord  "Enter new absolute coordinate",X#,Y#,Z#,ESC%
  1407.     Points#(Default,1)=x
  1408.     Points#(Default,2)=y
  1409.     Points#(Default,3)=z
  1410.     goto oops
  1411.  
  1412. alldone:
  1413. END SUB 'CreateLine
  1414. '*************************************************************************************
  1415. SUB CreatePolygon
  1416.  
  1417. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,ESC%
  1418. DIM PolyChoice$
  1419. DIM numedges#
  1420. DIM numedge&
  1421. DIM wireflag%    
  1422. DIM answer$
  1423. DIM saveassurface%    
  1424.  
  1425. POL1:
  1426.      Getletter "POLYGON -- Properties","(S)urface or (W)ire?","SW",answer$,ESC% 
  1427.     If ESC = true then goto POL8
  1428. '*********
  1429.      if answer$="S" then
  1430.         saveassurface=-1
  1431.      ELSE
  1432.         saveassurface=0
  1433.     end if
  1434. '*********
  1435. POL2:    
  1436.    GetLetter "POLYGON -- Construction","Construction Type: (C)enter or (E)dge","CE",PolyChoice,ESC%
  1437.     If ESC = true then goto POL1
  1438.  
  1439. POL3:
  1440.     GetValue "POLYGON -- Number of sides:",numedges#,ESC% 
  1441.     If ESC = true then goto POL2
  1442.      numedge = cint(numedges)        
  1443.   
  1444.     IF polychoice$="C" then
  1445. POL4:
  1446.          GetCoord    "POLYGON -- Enter the center of the polygon",X1#,Y1#,Z1#,ESC%
  1447.         If ESC = true then goto POL3
  1448. POL5:
  1449.          GetCoord    "POLYGON -- Middle of an edge" ,X2#,Y2#,Z2#,ESC%    
  1450.         If ESC = true then goto POL4
  1451.     ELSE
  1452. POL6:    
  1453.           GetCoord    "POLYGON -- Enter first vertex" ,X1#,Y1#,Z1#,ESC%    
  1454.         If ESC = true then goto POL3
  1455. POL7:
  1456.         GetCoord    "POLYGON -- Enter second vertex" ,X2#,Y2#,Z2#,ESC%                
  1457.         If ESC = true then goto POL6
  1458.      END IF
  1459. message saveassurface
  1460. message numedge
  1461.  
  1462. Withobject "CorelCAD.Automation.1"
  1463.     If PolyChoice = "C" then
  1464.         .Polygoncenter saveassurface,X1,Y1,Z1,X2,Y2,Z2,numedge
  1465.     ELSE
  1466.         .Polygonedge saveassurface,X1,Y1,Z1,X2,Y2,Z2,numedge        
  1467.     END IF
  1468. end withobject
  1469.  
  1470. POL8:
  1471. END SUB
  1472. '*************************************************************************************
  1473. SUB CreateRectangle
  1474.  
  1475. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,ESC%
  1476. DIM answer$,saveassurface%
  1477. RECTANGLE1:
  1478.                ESC=false          
  1479.                Getletter "RECTANGLE -- Properties","Save the object as a (S)urface or (W)ire?","SW",answer$,ESC% 
  1480.                if ESC=true then goto RECTANGLE4
  1481.                   if answer$="S" then
  1482.                        saveassurface=-1
  1483.                    else
  1484.                        saveassurface=0
  1485.                    endif 
  1486. RECTANGLE2:
  1487.                ESC=false         
  1488.              GetCoord    "Enter the start point of the rectangle",X1#,Y1#,Z1#,ESC%
  1489.                if ESC=true then goto RECTANGLE1
  1490. RECTANGLE3:
  1491.                ESC=false  
  1492.                GetCoord    "Enter the end point of the rectangle" ,X2#,Y2#,Z2#,ESC%    
  1493.                if ESC=true then goto RECTANGLE2 
  1494.                   
  1495. Withobject "corelcad.automation.1"
  1496.             .Rectangle saveassurface,X1,Y1,Z1,X2,Y2,Z2
  1497. end withobject
  1498.     
  1499. RECTANGLE4:
  1500. END SUB
  1501. '*************************************************************************************
  1502.  
  1503. SUB CreateSphere
  1504.  
  1505. DIM X1#
  1506. DIM Y1#
  1507. DIM Z1#
  1508. DIM ESC%
  1509. DIM Radius#
  1510. DIM SolidLet$
  1511. DIM WireFlag%
  1512. SPHERE1:
  1513.      ESC=false    
  1514.     GetLetter "SPHERE -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1515.      if ESC=true then goto SPHERE3
  1516.     SELECT CASE SolidLet$
  1517.         CASE "U"
  1518.             WireFlag% = 0        
  1519.         CASE "S"
  1520.             WireFlag% = 1
  1521.     END SELECT
  1522. SPHERE2:
  1523.      ESC=false    
  1524.     GetCoord  "SPHERE -- Pick center of the sphere",X1#,Y1#,Z1#,ESC%
  1525.       if ESC=true then goto SPHERE1
  1526.  
  1527.      ESC=false    
  1528.     GetValue  "SPHERE -- Enter the radius of the sphere",Radius#,ESC%
  1529.       if ESC=true then goto SPHERE2
  1530. WITHOBJECT "CorelCAD.Automation.1"
  1531.     .Sphere WireFlag,X1,Y1,Z1,X1+Radius,Y1,Z1
  1532. END WITHOBJECT
  1533. SPHERE3:
  1534.      
  1535. END SUB 'CreateSphere
  1536. '*************************************************************************************
  1537. SUB CreateTorus
  1538.     
  1539. DIM X1#,Y1#,Z1#,X2#,Y2#,Z2#,X3#,Y3#,Z3#,X4#,Y4#,Z4#,ESC%
  1540. DIM SolidLet$
  1541. DIM WireFlag%
  1542. TORUS1:
  1543.      ESC=false    
  1544.        GetLetter "TORUS -- Options","(S)olid, S(u)rface:","SU",SolidLet$,ESC%
  1545.      if ESC=true then goto TORUS5
  1546.     SELECT CASE SolidLet$
  1547.         CASE "U"
  1548.             WireFlag% = 0        
  1549.         CASE "S"
  1550.             WireFlag% = 1
  1551.     END SELECT
  1552. TORUS2:
  1553.      ESC=false        
  1554.     GetCoord  "TORUS -- Pick center of the torus",X1#,Y1#,Z1#,ESC%
  1555.      if ESC=true then goto TORUS1
  1556.      x2=x1
  1557.     y2=y1
  1558.     z2=y1
  1559. TORUS3:
  1560.      ESC=false    
  1561.     GetCoord  "TORUS -- Pick 2nd point (defines center of tube)",X2#,Y2#,Z2#,ESC%
  1562.      if ESC=true then goto TORUS2
  1563.      x3=x2
  1564.     y3=y2
  1565.     z3=y2
  1566. TORUS4:
  1567.      ESC=false    
  1568.     GetCoord  "TORUS -- Pick 3rd point (defines the plane of the torus)",X3#,Y3#,Z3#,ESC%
  1569.      if ESC=true then goto TORUS3
  1570.      x4=x3
  1571.     y4=y3
  1572.     z4=y3
  1573.  
  1574.      ESC=false    
  1575.         GetCoord "TORUS -- Pick 4th point (defines the height of the torus)",X4#,Y4#,Z4#,ESC%
  1576.       if ESC=true then goto TORUS4
  1577. WITHOBJECT "CorelCAD.Automation.1"
  1578.     .Torus WireFlag,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,X4,Y4,Z4
  1579. END WITHOBJECT
  1580. TORUS5:
  1581.      
  1582. donetor:
  1583. END SUB 'CreateTorus
  1584.  
  1585. '*************************************************************************************
  1586. '*************************************************************************************
  1587. '*************************************************************************************
  1588. '************************  MANIPULATING FUNCTIONS      *******************************
  1589. '*************************************************************************************
  1590. '*************************************************************************************
  1591. '*************************************************************************************
  1592. '*************************************************************************************
  1593. SUB GetCoord (DiaText,X#,Y#,Z#,ESC%)
  1594.  
  1595. DIM WantRel%            'boolean, if the user enters relative coords or not (@)
  1596. DIM TestPoly$,DispStr$
  1597. DIM WantAng%            'boolean, whether the user wants angular coords or not
  1598.  
  1599.     WantAng%= FALSE
  1600.     WantRel%= FALSE
  1601.     TestPoly$= DiaText
  1602.      
  1603.     DispStr$= "Enter a coordinate (x,y,z):"
  1604.  
  1605.     IF (VAL(LTRIM(TestPoly$)) > 1) AND (val(LTRIM(TestPoly$)) < 100) AND (CBOL(instr(TestPoly$,"ARRAY"))=false) then
  1606.         DispStr$= "OR: (C)lose,(D)one,(E)dit:"
  1607.         TempStr$= DiaText$
  1608.         DiaText$= "POLYINE -- Please choose point #"+TempStr$
  1609.     ENDIF
  1610.  
  1611.     
  1612. GtCoord:
  1613.     Coord$= "0,0,0"
  1614.     IF TestPoly$= "Enter new absolute coordinate" then Coord$= LTRIM(str(X))+","+LTRIM(STR(Y))+","+LTRIM(STR(z))
  1615.  
  1616.     BEGIN DIALOG PNT 47, 372, 254, 16, DiaText$
  1617.         TEXT  2, 3, 181, 13, DispStr$
  1618.         TEXTBOX  83, 2, 85, 13, Coord$
  1619.         OKBUTTON  170, 1, 40, 15
  1620.         CANCELBUTTON  214, 1, 40, 15
  1621.     END DIALOG
  1622.     
  1623.     ESC = FALSE
  1624.     ret = DIALOG (PNT)
  1625.     IF ret = 2 then 
  1626.         ESC = true
  1627.         goto done
  1628.     END IF
  1629.  
  1630.     IF (val(LTRIM(TestPoly$)) > 1) AND (val(LTRIM(TestPoly$)) < 100) then
  1631.         Coord$=UCASE (Coord$)
  1632.         SELECT CASE Coord$
  1633.             CASE "C"
  1634.                 DiaText$="C"
  1635.                 goto done
  1636.             CASE "D"
  1637.                 DiaText$="D"
  1638.                 goto done
  1639.             CASE "E"
  1640.                 DiaText$="E"
  1641.                 goto done
  1642.         END SELECT
  1643.     ENDIF
  1644.  
  1645.     Coord$=LTRIM (Coord$)
  1646.     Coord$=RTRIM (Coord$)
  1647.     IF (INSTR (Coord,"@")=1) then
  1648.          WantRel%= TRUE
  1649.         Coord$=RIGHT(Coord$,LEN(Coord$)-1) 
  1650.     ENDIF
  1651.     PosCom1%= INSTR(Coord$,",")
  1652.     PosCom2%= INSTR(Coord$,",",PosCom1+1)    
  1653.  
  1654.     If (PosCom2<>0) AND (INSTR(Coord$,",",PosCom2+1) <> 0) THEN
  1655.         goto Errror
  1656.        ELSE goto NotError
  1657.     ENDIF
  1658.  
  1659. Errror:
  1660.     BEGIN DIALOG Err 342, 94, "INCORRECT FORMAT"
  1661.         GROUPBOX  4, 36, 145, 48, "Examples of correct format"
  1662.         TEXT  71, 51, 40, 11, "1.5, 2.5, 3.5"
  1663.         TEXT  22, 49, 40, 11, "2, 3, 4"
  1664.         TEXT  31, 68, 106, 12, "1,3    (Z set to 0 as default)"
  1665.         TEXT  17, 8, 163, 8, "I'm sorry, you have entered an incorrect format. "
  1666.         TEXT  152, 24, 124, 16, "PLEASE TRY AGAIN"
  1667.         OKBUTTON  233, 47, 47, 16
  1668.         CANCELBUTTON  287, 47, 47, 16
  1669.     END DIALOG
  1670.         
  1671.     RET = DIALOG(Err)
  1672.     If RET = 2 then goto done
  1673.     Coord$="0,0,0"
  1674.     goto GtCoord
  1675. NotError:
  1676.     
  1677.     Num1$= LEFT(Coord$, PosCom1-1)
  1678.     Num2$= MID(Coord$, PosCom1+1, PosCom2-PosCom1-1)    
  1679.     Num3$= RIGHT(Coord$,LEN(Coord$)-PosCom2)
  1680.  
  1681.     If PosCom1=0 then 
  1682.             Num1$=Coord$
  1683.             Num2$="0"
  1684.             Num3$="0"
  1685.         ELSEIF PosCom2=0 then
  1686.             Num2$=RIGHT(Coord$,LEN(Coord$)-PosCom1)
  1687.             Num3$="0"    
  1688.     ENDIF
  1689.         
  1690.     Num1=LTRIM (Num1)
  1691.     Num1=RTRIM (Num1)
  1692.     Num2=LTRIM (Num2)    
  1693.     Num2=RTRIM (Num2)
  1694.     Num3=LTRIM (Num3)
  1695.     Num3=RTRIM (Num3)    
  1696.             
  1697.     If (Num1$ = "0") OR (Num1$ = "0.") OR (Num1$ = "0.0") OR (Num1$ = "0.00") then 
  1698.             X=0
  1699.         ELSEIF WantRel%=TRUE then
  1700.             X=VAL(Num1$)+X
  1701.         ELSEIF VAL(Num1$)=0 then
  1702.             goto Errror
  1703.         ELSE
  1704.             X=VAL(Num1$)                
  1705.     ENDIF
  1706.  
  1707.     If (Num2$ = "0") OR (Num2$ = "0.") OR (Num2$ = "0.0") OR (Num2$ = "0.00") then 
  1708.             Y=0
  1709.         ELSEIF WantRel%=TRUE then
  1710.             y=VAL(Num2$)+Y
  1711.         ELSEIF VAL(Num2$)=0 then
  1712.             goto Errror
  1713.         ELSE
  1714.             y=VAL(Num2$)                
  1715.     ENDIF
  1716.  
  1717.     IF (Num3$ = "0") OR (Num3$ = "0.") OR (Num3$ = "0.0") OR (Num3$ = "0.00") then 
  1718.             Z=0
  1719.         ELSEIF WantRel%=TRUE then
  1720.             Z=VAL(Num3$)+Z
  1721.         ELSEIF VAL(Num3$)=0 then
  1722.             goto Errror
  1723.         ELSE
  1724.             Z=VAL(Num3$)                
  1725.     ENDIF    
  1726.  
  1727. Done:
  1728.  
  1729. END SUB
  1730. '*************************************************************************************
  1731. SUB GetValue (DiaText,dX,ESC%)
  1732.  
  1733. DIM ArrBool%
  1734.  
  1735. Dist:
  1736. Num$="0"
  1737. ArrBool= CBOL(instr(DiaText$,"of copies"))            'will be true if this fcn is being called from an array command
  1738.  
  1739. If (ArrBool=true) then Num$="2"                'sets a new default, numcopies as being 2
  1740. If CBOL(instr(DiaText$,"of copies  "))=true then Num$=20
  1741. If CBOL(instr(DiaText$,"Arc Angle"))=true then Num$=180
  1742. If CBOL(instr(DiaText$,"Y -- Angle of"))=true then Num$=360
  1743.  
  1744.  
  1745. BEGIN DIALOG Dialog1 47, 372, 254, 16, DiaText$
  1746.     TEXT  7, 4, 144, 12, "Please enter a value:"
  1747.     TEXTBOX  76, 3, 88, 13, Num$
  1748.     OKBUTTON  170, 1, 40, 15
  1749.     CANCELBUTTON  214, 1, 40, 15
  1750. END DIALOG
  1751.  
  1752. ESC= false
  1753. ret = DIALOG(Dialog1)                
  1754. If ret=2 then ESC = true
  1755.                 
  1756. Num = LTRIM (Num)
  1757. Num = RTRIM (Num)
  1758.  
  1759. If (Num$ = "0") OR (Num$ = "0.") OR (Num$ = "0.0") OR (Num$ = "0.00") then 
  1760.             dX=0
  1761.         ELSEIF (ArrBool=True)AND(Val(Num$)-cint(val(Num$)) <>0) then        'checks if user entered integer(for array command)
  1762.             Message ("I'm sorry, but you must enter an integer. Please try again")
  1763.             goto DIST
  1764.         ELSEIF VAL(Num$)=0 then
  1765.             BEGIN DIALOG Errr 334, 75, "INCORRECT ENTRY"
  1766.                 GROUPBOX  4, 36, 145, 29, "Examples of correct format"
  1767.                 TEXT  14, 51, 40, 11, "1.5"    
  1768.                 TEXT  66, 51, 40, 11, "2"
  1769.                 TEXT  102, 51, 40, 11, "6.56677889"
  1770.                 TEXT  17, 8, 163, 8, "I'm sorry, you have entered an incorrect format. "
  1771.                 TEXT  152, 24, 124, 16, "PLEASE TRY AGAIN"
  1772.                 OKBUTTON  233, 47, 47, 16
  1773.                 CANCELBUTTON  287, 47, 47, 16
  1774.             END DIALOG
  1775.             ret = DIALOG(ERRR)                
  1776.             If ret=2 then stop
  1777.             goto DIST
  1778.         ELSE
  1779.             dX=VAL(Num$)            
  1780.     ENDIF
  1781. donedis: 
  1782.  
  1783. END SUB
  1784. '*************************************************************************************
  1785. '*************************************************************************************
  1786. SUB GetLetter(TitleText$,DiaText$,LetAvail$,LetPicked$,ESC%)
  1787.  
  1788.             ' the first character in the LetAvail string will be assigned to this variable
  1789.  
  1790.     DO 
  1791.         LetAvail = UCASE (LetAvail)
  1792.         LetPicked = LEFT (LetAvail,1)
  1793.  
  1794.         BEGIN DIALOG DiaLetter 47, 372, 254, 16, TitleText$
  1795.             TEXT  0, 4, 197, 12, DiaText$
  1796.             TEXTBOX  118, 2, 48, 13, LetPicked$
  1797.             OKBUTTON  170, 1, 40, 15
  1798.             CANCELBUTTON  212, 1, 40, 15
  1799.         END DIALOG
  1800.  
  1801.         ret=DIALOG(DiaLetter)
  1802.         If ret =2 then 
  1803.             ESC = TRUE
  1804.             goto DONELETTER
  1805.         end IF
  1806.         LetPicked=LTRIM(LetPicked)        
  1807.         LetPicked=RTRIM(LetPicked)
  1808.         LetPicked=UCASE(LetPicked)
  1809.  
  1810.         Correct= CBOL(instr(LetAvail,LetPicked))
  1811.         If Correct=false then message "Sorry, not a correct entry. Pick a character in brackets."
  1812.  
  1813.     LOOP WHILE Correct = FALSE
  1814.  
  1815.  
  1816.  
  1817. DONELETTER:
  1818. END SUB
  1819. '*************************************************************************************
  1820. '*************************************************************************************
  1821.  
  1822. SUB DoMove
  1823.  
  1824. DIM dX#,dY#,dZ#,ESC%        ' the user defines the offset wanted
  1825.  
  1826.     GetValue  "Enter an offset in the X-direction",dX#,ESC%
  1827.     GetValue  "Enter an offset in the Y-direction",dY#,ESC%    
  1828.     GetValue  "Enter an offset in the Z-direction",dZ#,ESC%
  1829.  
  1830. WITHOBJECT "CorelCAD.Automation.1"
  1831.     .move 0,0,0,0,0,dX#,dY#,dZ#
  1832. END WITHOBJECT
  1833.  
  1834. END SUB
  1835. '*************************************************************************************
  1836. '*************************************************************************************
  1837. SUB DoScale
  1838.  
  1839. DIM ScaleNum#
  1840. DIM X#,Y#,Z#,ESC%
  1841.  
  1842.     GetValue "Enter a scale factor",ScaleNum#,ESC%
  1843.     GetCoord "SCALE -- Base Point",x#,Y#,Z#,ESC%
  1844.  
  1845. WITHOBJECT "CorelCAD.Automation.1"
  1846.     .Scale 0,ScaleNum#,X,Y,Z
  1847. END WITHOBJECT
  1848.  
  1849. END SUB
  1850. '*************************************************************************************
  1851. '*************************************************************************************
  1852. SUB DoExtrude
  1853.  
  1854.  
  1855. DIM X#,Y#,Z#,X2#,Y2#,Z2#,Scale#,Scalevalue%,ESC%
  1856.  
  1857. withobject"corelcad.automation.1"
  1858. EXTRUDE1:
  1859.      ESC=false
  1860.      Getcoord "EXTRUDE -- Enter the first point:",X#,Y#,Z#,ESC%
  1861.      if ESC=true then goto EXTRUDE3
  1862. EXTRUDE2:
  1863.      ESC=false
  1864.      Getcoord "EXTRUDE -- Enter the  Second point",X2#,Y2#,Z2#,ESC%
  1865.      if ESC=true then goto EXTRUDE1
  1866.   
  1867.      Getvalue "EXTRUDE -- Please enter extrusion scale",scale#,ESC%
  1868.      if ESC=true then goto EXTRUDE2  
  1869.      Scalevalue%=cint(scale)
  1870.  
  1871.  
  1872. .StartAddCmdPoint 2
  1873.     .AddCmdPoint X#,Y#,Z#
  1874.     .addcmdpoint X2#,Y2#,Z2#
  1875. .EndAddCmdPoint
  1876.  
  1877.  
  1878. .extrude .extrudescale = scalevalue
  1879.  
  1880. end withobject
  1881. EXTRUDE3:
  1882.  
  1883. END SUB
  1884. '*************************************************************************************
  1885. '*************************************************************************************
  1886. SUB DoPaste
  1887.  
  1888. DIM X#,Y#,Z#,ESC%
  1889.  
  1890. Withobject "CorelCAD.Automation.1"
  1891.      GetCoord "PASTE -- Enter the coordinate for object placement:",X#,Y#,Z#,ESC%
  1892.     .EditPaste X,Y,Z
  1893. end withobject
  1894.  
  1895. END SUB
  1896.  
  1897.  
  1898. '*************************************************************************************
  1899. '*************************************************************************************
  1900. SUB DoChangeColor
  1901.  
  1902. DIM ColorChoice%
  1903. DIM Color$(7)
  1904. DIM Red%,Green%,Blue%
  1905.  
  1906. ColorChoice = 1
  1907.  
  1908. Color(1)="Red"
  1909. Color(2)="Orange"
  1910. Color(3)="Yellow"
  1911. Color(4)="Green"
  1912. Color(5)="Blue"
  1913. Color(6)="Indigo"
  1914. Color(7) ="Violet"
  1915.  
  1916. BEGIN DIALOG ColorDlg 97, 118, "CHANGE COLOR"
  1917.     GROUPBOX  4, 6, 83, 85, "Colors Available"
  1918.     LISTBOX  15, 20, 62, 67, Color$, ColorChoice%
  1919.     OKBUTTON  6, 100, 40, 14
  1920.     CANCELBUTTON  50, 100, 40, 14
  1921. END DIALOG
  1922.  
  1923. ret = DIALOG(ColorDlg)
  1924. If ret = 2 then goto Done:
  1925.  
  1926. WithObject "CorelCAD.Automation.1"
  1927.  
  1928.     Select Case ColorChoice
  1929.         Case 1
  1930.             .ChangeColor 255, 0, 51
  1931.         Case 2
  1932.             .ChangeColor 255, 153, 0
  1933.         Case 3
  1934.             .ChangeColor 255, 255, 0
  1935.         Case 4
  1936.             .ChangeColor 51, 255, 0
  1937.         Case 5
  1938.             .ChangeColor 0, 0, 255
  1939.         Case 6    
  1940.             .ChangeColor 0, 255, 255
  1941.         Case 7
  1942.             .ChangeColor 51, 0, 102
  1943.     END SELECT
  1944. End WithObject
  1945.  
  1946. DONE:
  1947. END SUB
  1948. '*************************************************************************************
  1949. '*************************************************************************************
  1950. SUB DoZoom
  1951.  
  1952. DIM Zoom$            'letter picked for zoom
  1953. DIM X#,Y#,Z#,X1#,Y1#,Z1#
  1954.  
  1955. ZZ2:
  1956.     GetLetter "Zoom Type","(A)ll,(S)elected,(I)n,(O)ut,(P)revious","ASIOP",Zoom$,ESC%
  1957.     If ESC = true then goto Doo
  1958. Withobject "CorelCAD.Automation.1"
  1959. Select Case Zoom
  1960.     CASE "A"
  1961.         .zoomToAll
  1962.     CASE "S"
  1963.         .ZoomToSelected
  1964.     CASE "I"
  1965. ZZ1:
  1966.         GetCoord "Enter the first point for the zoom box:",X#,Y#,Z#,ESC%
  1967.         If ESC = true then goto ZZ2
  1968.         X1=X
  1969.         Y1=Y
  1970.         Z1=Z
  1971.         GetCoord "Enter the end point for the zoom box:",X1#,Y1#,Z1#,ESC%
  1972.         If ESC = true then goto ZZ1
  1973.         .ZoomIn X,Y,Z,X1,Y1,Z1
  1974.     CASE "O"
  1975.         .ZoomOut 
  1976.     CASE "P"    
  1977.         .ZoomPrevious
  1978. end select
  1979.  
  1980. End Withobject
  1981.     
  1982. doo:
  1983. END SUB
  1984.  
  1985.  
  1986.  
  1987.  
  1988.  
  1989.