Guest User

Untitled

a guest
Dec 10th, 2018
76
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VB.NET 7.19 KB | None | 0 0
  1. Dim swApp As Object
  2.  
  3. Dim Part As Object
  4. Dim boolstatus As Boolean
  5. Dim longstatus As Long, longwarnings As Long
  6. Dim skSegment As Object
  7. Dim myFeature    As Object
  8. Dim R1 As Double
  9. Dim R2 As Double
  10. Dim R3 As Double
  11. Dim R4 As Double
  12. Dim R5 As Double
  13. Dim H1 As Double
  14. Dim H2 As Double
  15. Dim H3 As Double
  16. Dim H4 As Double
  17.  
  18. Sub main()
  19.  
  20. Set swApp = Application.SldWorks
  21. Set Part = swApp.ActiveDoc
  22.  
  23. R1 = 20 / 1000
  24. R2 = 30 / 1000
  25. R3 = 80 / 1000
  26. R4 = 90 / 1000
  27. R5 = 120 / 1000
  28. H1 = 10 / 1000
  29. H2 = 5 / 1000
  30. H3 = 8 / 1000
  31. H4 = 6 / 1000
  32.  
  33. ''''''''''''''''''''''''''''''''''''''''''''''
  34. 'Bossage 1''''''''''''''''''''''''''''''''''''
  35. ''''''''''''''''''''''''''''''''''''''''''''''
  36. boolstatus = Part.Extension.SelectByID2("Plan de face", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
  37. Part.SketchManager.InsertSketch True
  38. Dim skSegment As Object
  39. Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.015723, 0.009153, 0#)
  40. Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.023747, 0.01492, 0#)
  41. Part.ClearSelection2 True
  42. 'Renommer l'esquisse
  43. Set swSketch = Part.GetActiveSketch2
  44. Set swFeat = swSketch
  45. swFeat.Name = "esq1"
  46. 'Cotation 1
  47. boolstatus = Part.Extension.SelectByID2("Arc1", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
  48. Set myDisplayDim = Part.AddDimension2(0, 0, 0)
  49. Part.Parameter("D1@esq1").SystemValue = R1 * 2
  50. 'Cotation 2
  51. boolstatus = Part.Extension.SelectByID2("Arc2", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
  52. Set myDisplayDim = Part.AddDimension2(0, 0, 0)
  53. Part.Parameter("D2@esq1").SystemValue = R2 * 2
  54. Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 6, 0, H1, H1, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
  55. Part.SelectionManager.EnableContourSelection = False
  56. Part.ClearSelection2 True
  57.  
  58. ''''''''''''''''''''''''''''''''''''''''''''''
  59. 'Bossage 2''''''''''''''''''''''''''''''''''''
  60. ''''''''''''''''''''''''''''''''''''''''''''''
  61. boolstatus = Part.Extension.SelectByID2("Plan de face", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
  62. Part.SketchManager.InsertSketch True
  63. Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.023747, 0.01492, 0#)
  64. Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.054088, 0.023947, 0#)
  65. Part.ClearSelection2 True
  66. 'Renommer l'esquisse
  67. Set swSketch = Part.GetActiveSketch2
  68. Set swFeat = swSketch
  69. swFeat.Name = "esq2"
  70. 'Cotation 1
  71. boolstatus = Part.Extension.SelectByID2("Arc1", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
  72. Set myDisplayDim = Part.AddDimension2(0, 0, 0)
  73. Part.Parameter("D1@esq2").SystemValue = R2 * 2
  74. 'Cotation 2
  75. boolstatus = Part.Extension.SelectByID2("Arc2", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
  76. Set myDisplayDim = Part.AddDimension2(0, 0, 0)
  77. Part.Parameter("D2@esq2").SystemValue = R3 * 2
  78. Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 6, 0, H2, H2, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
  79. Part.SelectionManager.EnableContourSelection = False
  80. Part.ClearSelection2 True
  81.  
  82. ''''''''''''''''''''''''''''''''''''''''''''''
  83. 'Bossage 3''''''''''''''''''''''''''''''''''''
  84. ''''''''''''''''''''''''''''''''''''''''''''''
  85. boolstatus = Part.Extension.SelectByID2("Plan de face", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
  86. Part.SketchManager.InsertSketch True
  87. Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.054088, 0.023947, 0#)
  88. Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.072393, 0.002382, 0#)
  89. Part.ClearSelection2 True
  90. 'Renommer l'esquisse
  91. Set swSketch = Part.GetActiveSketch2
  92. Set swFeat = swSketch
  93. swFeat.Name = "esq3"
  94. 'Cotation 1
  95. boolstatus = Part.Extension.SelectByID2("Arc1", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
  96. Set myDisplayDim = Part.AddDimension2(0, 0, 0)
  97. Part.Parameter("D1@esq3").SystemValue = R3 * 2
  98. 'Cotation 2
  99. boolstatus = Part.Extension.SelectByID2("Arc2", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
  100. Set myDisplayDim = Part.AddDimension2(0, 0, 0)
  101. Part.Parameter("D2@esq3").SystemValue = R4 * 2
  102. Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 6, 0, H3, H3, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
  103. Part.SelectionManager.EnableContourSelection = False
  104. Part.ClearSelection2 True
  105.  
  106. ''''''''''''''''''''''''''''''''''''''''''''''
  107. 'Bossage 4''''''''''''''''''''''''''''''''''''
  108. ''''''''''''''''''''''''''''''''''''''''''''''
  109. boolstatus = Part.Extension.SelectByID2("Plan de face", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
  110. Part.SketchManager.InsertSketch True
  111. Part.ClearSelection2 True
  112. Set skSegment = Part.SketchManager.CreateLine(R4, 0#, 0#, R3 * Cos(30 * 3.14 / 360), R3 * Sin(30 * 3.14 / 360), 0#)
  113. Set skSegment = Part.SketchManager.CreateLine(R3 * Cos(30 * 3.14 / 360), R3 * Sin(30 * 3.14 / 360), 0#, R4 * 2, 0#, 0#)
  114. Set skSegment = Part.SketchManager.CreateLine(R4 * 2, 0#, 0#, R3 * Cos(30 * 3.14 / 360), R3 * -Sin(30 * 3.14 / 360), 0#)
  115. Set skSegment = Part.SketchManager.CreateLine(R3 * Cos(30 * 3.14 / 360), R3 * -Sin(30 * 3.14 / 360), 0#, R4, 0#, 0#)
  116. Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 6, 0, H4, H4, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
  117. Part.SelectionManager.EnableContourSelection = False
  118. Part.ClearSelection2 True
  119.  
  120. boolstatus = Part.Extension.SelectByID2("Plan de dessus", "PLANE", 0, 0, 0, True, 0, Nothing, 0)
  121. boolstatus = Part.Extension.SelectByID2("Plan de droite", "PLANE", 0, 0, 0, True, 0, Nothing, 0)
  122. boolstatus = Part.InsertAxis2(True)
  123. Part.ClearSelection2 True
  124.  
  125. boolstatus = Part.Extension.SelectByID2("Boss.-Extru.4", "BODYFEATURE", 0, 0, 0, True, 4, Nothing, 0)
  126. Part.ActivateSelectedFeature
  127. boolstatus = Part.Extension.SelectByID2("Axe1", "AXIS", 0, 0, 0, True, 1, Nothing, 0)
  128. Part.ClearSelection2 True
  129. boolstatus = Part.Extension.SelectByID2("Boss.-Extru.4", "BODYFEATURE", 0, 0, 0, False, 4, Nothing, 0)
  130. boolstatus = Part.Extension.SelectByID2("Axe1", "AXIS", 0, 0, 0, True, 1, Nothing, 0)
  131. Set myFeature = Part.FeatureManager.FeatureCircularPattern5(12, 6.2831853071796, False, "NULL", False, True, False, False, False, False, 1, 0.26179938779915, "NULL", False)
  132. Part.ClearSelection2 True
  133.  
  134. ''''''''''''''''''''''''''''''''''''''''''''''
  135. 'Enlev''''''''''''''''''''''''''''''''''''''''
  136. ''''''''''''''''''''''''''''''''''''''''''''''
  137. boolstatus = Part.Extension.SelectByID2("Plan de face", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
  138. Part.SketchManager.InsertSketch True
  139. Part.ClearSelection2 True
  140. Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.054088, 0.023947, 0#)
  141. Part.ClearSelection2 True
  142. 'Renommer l'esquisse
  143. Set swSketch = Part.GetActiveSketch2
  144. Set swFeat = swSketch
  145. swFeat.Name = "esq5"
  146. 'Cotation 1
  147. boolstatus = Part.Extension.SelectByID2("Arc1", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
  148. Set myDisplayDim = Part.AddDimension2(0, 0, 0)
  149. Part.Parameter("D1@esq5").SystemValue = R5 * 2
  150. Set myFeature = Part.FeatureManager.FeatureCut4(False, True, False, 9, 1, 0.01, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, False, True, True, True, True, False, 0, 0, False, False)
  151. Part.SelectionManager.EnableContourSelection = False
  152. Part.ClearSelection2 True
  153.  
  154. End Sub
Add Comment
Please, Sign In to add comment