home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / v8trial / TurboCADv8ProfessionalNoReg.exe / Data.Cab / F42286_mAddXRefTst.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-16  |  7.2 KB  |  292 lines
  1. Attribute VB_Name = "mAddViewportXRefTst"
  2. '******************************************************************'
  3. '*                                                                *'
  4. '*                      TurboCAD for Windows                      *'
  5. '*                   Copyright (c) 1993 - 2001                    *'
  6. '*             International Microcomputer Software, Inc.         *'
  7. '*                            (IMSI)                              *'
  8. '*                      All rights reserved.                      *'
  9. '*                                                                *'
  10. '******************************************************************'
  11.  
  12.  
  13. Const vpW = 3
  14. Const vpH = 3
  15.  
  16. Const strXRef1 = "d:\tc80\bin\usa\drawings\drawing1.tcw"
  17. Const strXRef2 = "d:\tc80\bin\usa\drawings\drawing2.tcw"
  18. Const strXRef3 = "d:\tc80\bin\usa\drawings\drawing3.tcw"
  19. Const strXRef4 = "d:\tc80\bin\usa\drawings\drawing4.tcw"
  20.  
  21. Private Sub AddXRefs()
  22.     Dim gxBlks As Blocks
  23.     Dim gxGrs As Graphics
  24.     Dim gxVrt As Vertex
  25.     
  26.     Dim x As Double
  27.     Dim y As Double
  28.     Dim z As Double
  29.     
  30.     Dim dx As Double
  31.     Dim dy As Double
  32.     Dim dz As Double
  33.     
  34.     Dim gxGrXRef1 As Graphic
  35.     Dim gxGrXRef2 As Graphic
  36.     Dim gxGrXRef3 As Graphic
  37.     Dim gxGrXRef4 As Graphic
  38.     
  39.     Dim gxBBox1 As BoundingBox
  40.     Dim gxBBox2 As BoundingBox
  41.     Dim gxBBox3 As BoundingBox
  42.     Dim gxBBox4 As BoundingBox
  43.     
  44.     Set gxBlks = ActiveDrawing.Blocks
  45.     
  46.     gxBlks.AddXref "XRef1", strXRef1, 0, 0, 0
  47.     gxBlks.AddXref "XRef2", strXRef2, 0, 0, 0
  48.     gxBlks.AddXref "XRef3", strXRef3, 0, 0, 0
  49.     gxBlks.AddXref "XRef4", strXRef4, 0, 0, 0
  50.  
  51.     Set gxGrs = ActiveDrawing
  52.     Set gxGrXRef1 = gxGrs.AddBlockInsertion("XRef1", 0, 0, 0, 1, 1, 1)
  53.     Set gxGrXRef2 = gxGrs.AddBlockInsertion("XRef2", 0, 0, 0, 1, 1, 1)
  54.     Set gxGrXRef3 = gxGrs.AddBlockInsertion("XRef3", 0, 0, 0, 1, 1, 1)
  55.     Set gxGrXRef4 = gxGrs.AddBlockInsertion("XRef4", 0, 0, 0, 1, 1, 1)
  56.     
  57.     Set gxBBox1 = gxGrXRef1.CalcBoundingBox
  58.     Set gxBBox2 = gxGrXRef2.CalcBoundingBox
  59.     Set gxBBox3 = gxGrXRef3.CalcBoundingBox
  60.     Set gxBBox4 = gxGrXRef4.CalcBoundingBox
  61.  
  62.     y = (gxBBox1.Max.y + gxBBox1.Min.y) / 2
  63.     dy = y - ((gxBBox2.Max.y + gxBBox2.Min.y) / 2)
  64.  
  65.     x = gxBBox1.Max.x + (gxBBox2.Max.x - gxBBox2.Min.x) / 2
  66.     dx = x - (gxBBox2.Max.x + gxBBox2.Min.x) / 2 + 2
  67.     
  68.     z = (gxBBox1.Max.z + gxBBox1.Min.z) / 2
  69.     dz = z - (gxBBox2.Max.z + gxBBox2.Min.z) / 2
  70.  
  71.     gxGrXRef2.MoveRelative dx, dy, dz
  72.  
  73.     x = (gxBBox1.Max.x + gxBBox1.Min.x) / 2
  74.     dx = x - ((gxBBox3.Max.x + gxBBox3.Min.x) / 2)
  75.  
  76.     y = gxBBox1.Max.y + (gxBBox3.Max.y - gxBBox3.Min.y) / 2
  77.     dy = y - (gxBBox3.Max.y + gxBBox3.Min.y) / 2 + 2
  78.     
  79.     z = (gxBBox1.Max.z + gxBBox1.Min.z) / 2
  80.     dz = z - (gxBBox3.Max.z + gxBBox3.Min.z) / 2
  81.  
  82.     gxGrXRef3.MoveRelative dx, dy, dz
  83.  
  84.     Set gxBBox3 = gxGrXRef3.CalcBoundingBox
  85.     
  86.     y = (gxBBox3.Max.y + gxBBox3.Min.y) / 2
  87.     dy = y - ((gxBBox4.Max.y + gxBBox4.Min.y) / 2)
  88.  
  89.     x = gxBBox3.Max.x + (gxBBox4.Max.x - gxBBox4.Min.x) / 2
  90.     dx = x - (gxBBox4.Max.x + gxBBox4.Min.x) / 2 + 2
  91.     
  92.     z = (gxBBox3.Max.z + gxBBox3.Min.z) / 2
  93.     dz = z - (gxBBox4.Max.z + gxBBox4.Min.z) / 2
  94.  
  95.     gxGrXRef4.MoveRelative dx, dy, dz
  96.     
  97.     ActiveDrawing.ActiveView.ZoomToExtents
  98.  
  99. End Sub
  100.  
  101. Private Function AddXRefNamedView(gxNVws As NamedViews, gxGr As Graphic) As Long
  102.  
  103.     Dim gxBBox As BoundingBox
  104.     Dim cnt As Long
  105.  
  106.     cnt = 0
  107.     If (gxGr.TypeByValue <> imsiInsert) Then
  108.         GoTo LExit
  109.     End If
  110.  
  111.     Set gxBBox = gxGr.CalcBoundingBox
  112.     
  113.     On Error GoTo LExit
  114.     gxNVws.Add "View to " & gxGr.Block.Name, gxBBox.Min.x - 1, gxBBox.Min.y - 1, gxBBox.Max.x + 1, gxBBox.Max.y + 1
  115.     
  116.     cnt = 1
  117.  
  118. LExit:
  119.     AddXRefNamedView = cnt
  120.     
  121. End Function
  122.  
  123. Private Function AddXRefNamedViews(gxNVws As NamedViews) As Long
  124.  
  125.     Dim cnt As Long
  126.     
  127.     Dim gxGrs As Graphics
  128.     Dim gxGr As Graphic
  129.     
  130.     Dim gxCam As Camera
  131.     
  132.     Dim gxVPos As Vertex
  133.     Dim gxVLook As Vertex
  134.     Dim gxVDir As Vertex
  135.  
  136.     cnt = 0
  137.     
  138.     AddXRefs
  139.     
  140.     Set gxCam = ActiveDrawing.ActiveView.Camera
  141.     
  142.     Set gxVPos = gxCam.Location
  143.     Set gxVLook = gxCam.LookAt
  144.     Set gxVDir = gxCam.Direction
  145.     
  146.     gxVPos.x = 0
  147.     gxVPos.y = 0
  148.     gxVPos.z = 1
  149.     
  150.     gxVLook.x = 0
  151.     gxVLook.y = 0
  152.     gxVLook.z = 0
  153.     
  154.     gxVDir.x = 0
  155.     gxVDir.y = 1
  156.     gxVDir.z = 0
  157.     
  158.     gxCam.CameraSetSpaceParameters gxVPos, gxVLook, gxVDir
  159.     
  160.     ActiveDrawing.ActiveView.ZoomToExtents
  161.     
  162.     Set gxGrs = ActiveDrawing.Graphics
  163.     
  164.     For Each gxGr In gxGrs
  165.         
  166.         cnt = cnt + AddXRefNamedView(gxNVws, gxGr)
  167.     
  168.     Next
  169.  
  170.     AddXRefNamedViews = cnt
  171.  
  172. End Function
  173.  
  174. Private Function AddXRefViewport(gxGrs As Graphics, gxNVw As NamedView) As Graphic
  175.  
  176.     Dim gxGr As Graphic
  177.     Dim gxVrts As Vertices
  178.     Dim gxVrt As Vertex
  179.     Dim right As Double
  180.     Dim bottom As Double
  181.     Dim left As Double
  182.     Dim top As Double
  183.     
  184.     Set gxGr = gxGrs.Add(imsiViewport)
  185.     gxGr.Properties("NamedView") = gxNVw.Name
  186.  
  187.     Set gxVrts = gxGr.Vertices
  188.     Set gxVrt = gxVrts(0)
  189.     left = gxVrt.x
  190.     top = gxVrt.y
  191.     
  192.     right = left + vpW
  193.     bottom = top - vpH
  194.     
  195.     Set gxVrt = gxVrts(1)
  196.     gxVrt.y = bottom
  197.     
  198.     Set gxVrt = gxVrts(2)
  199.     gxVrt.y = bottom
  200.     gxVrt.x = right
  201.     
  202.     Set gxVrt = gxVrts(3)
  203.     gxVrt.x = right
  204.  
  205.     Set AddXRefViewport = gxGr
  206.  
  207. End Function
  208.  
  209. Public Sub AddXRefViewports()
  210.  
  211.     Dim gxNVws As NamedViews
  212.     
  213.     Dim gxProps As Properties
  214.     Dim gxProp As Property
  215.     Dim OldSpace As Long
  216.     
  217.     Dim gxGrs As Graphics
  218.     Dim gxGr As Graphic
  219.     
  220.     Dim cnt As Long
  221.     Dim cntCur As Long
  222.     Dim cntOld As Long
  223.     Dim ind As Long
  224.     
  225.     Dim dXY As Integer
  226.     Dim vpX As Double
  227.     Dim vpY As Double
  228.     
  229.     Set gxProps = ActiveDrawing.Properties
  230.     Set gxProp = gxProps("TileMode")
  231.  
  232.     OldSpace = gxProp
  233.  
  234.     If (OldSpace <> 1) Then
  235.         gxProp = 1 ' set model space
  236.     End If
  237.     
  238.     Set gxProps = ActiveDrawing.Properties
  239.     Set gxProp = gxProps("TileMode")
  240.  
  241.     OldSpace = gxProp
  242.  
  243.     If (OldSpace <> 1) Then
  244.         gxProp = 1 ' set model space
  245.     End If
  246.     
  247.     Set gxNVws = ActiveDrawing.NamedViews
  248.     cntOld = gxNVws.Count
  249.     cnt = AddXRefNamedViews(gxNVws)
  250.  
  251.     If (cnt > 0) Then
  252.         gxProp = 0 ' set paper space
  253.     
  254.         Set gxGrs = ActiveDrawing.Graphics
  255.         cntCur = gxNVws.Count
  256.         
  257.         vpX = vpW / 2 + 0.5
  258.         vpY = vpH / 2 + 1
  259.         dXY = 0
  260.         
  261.         For ind = cntOld To cntCur - 1
  262.         
  263.             Set gxGr = AddXRefViewport(gxGrs, gxNVws(ind))
  264.         
  265.             gxGr.MoveAbsolute vpX, vpY, 0
  266.         
  267.             Select Case dXY
  268.             Case 1
  269.                 vpX = vpX + vpW + 1
  270.                 dXY = dXY + 1
  271.             Case 0
  272.                 vpY = vpY + vpH + 1
  273.                 dXY = dXY + 1
  274.             Case 3
  275.                 vpX = vpX - vpW - 1
  276.                 dXY = dXY + 1
  277.             Case 2
  278.                 vpY = vpY - vpH - 1
  279.                 dXY = 0
  280.             End Select
  281.         
  282.             gxGr.Draw
  283.         
  284.         Next ind
  285.     
  286.     Else
  287.         gxProp = OldSpace
  288.     End If
  289.  
  290. End Sub
  291.  
  292.