Sub Main '[ *** Checks DWG is active *** If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then MsgBox("A Drawing Document must be active for this rule to work. Exiting.",vbCritical, "Wrong Document Type") Exit Sub End If '] '[ *** Select a view to adjust *** View: Dim oView As DrawingView = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingViewFilter, "Select a View to Edit.") If oView Is Nothing Then Exit Sub End If '] '[ *** Set Perameters *** On Error GoTo ErrorMsg If oView.ViewType = DrawingViewTypeEnum.kSectionDrawingViewType Then Dim oSecView As SectionDrawingView = oView If oSecView.HatchRegions.Count > 0 Then '] '[ *** Select Option 1 *** Options1: Dim oOptions1 As New List(Of String) oOptions1.Add("Angle") oOptions1.Add("Scale") oOptions1.Add("Visibility") oOptions1.Add("----------") oOptions1.Add("Select a New View") oOptions1.Add("----------") oOptions1.Add("Set Hatch ByMaterial") oOptions1.Add("Change Hatch Pattern") oOption1 = InputListBox("Choose what you" _ & vbCrLf & "would like to do !!", oOptions1, oOption1, Title := "Hatch Properties", ListName := "What would you like to adjust?") If oOption1 = "" Then Exit Sub Else If oOption1 = "Angle" Then GoTo SelectAngle Else If oOption1 = "Scale" Then GoTo SelectScale Else If oOption1 = "Visibility" Then GoTo Visibility Else If oOption1 = "----------" Then GoTo Options1 Else If oOption1 = "Select a New View" Then GoTo View Else If oOption1 = "Set Hatch ByMaterial" Then GoTo byMaterial Else If oOption1 = "Change Hatch Pattern" Then GoTo SelectPattern End If End If '] '[ *** Turn hatching off *** Visibility: Dim oMB1 = MessageBox.Show("Do You Want To Turn All Hatching Off ?", "Hatch Properties", MessageBoxButtons.YesNo,MessageBoxIcon.Warning, MessageBoxDefaultButton.Button2) If oMB1 = vbYes Then For Each oHR As DrawingViewHatchRegion In oSecView.HatchRegions If oHR.Visible Then oHR.Visible = False Next Exit Sub Else If oMB1 = vbNo Then GoTo Options1 '] '[ *** Select new angle *** SelectAngle : oAngle = InputBox("Enter New Hatch Angle." _ & vbCrLf & vbCrLf & "Note:- Do Not Use '0' Enter '180'.", "Hatch Properties", "45") If oAngle <> 0 Then For Each oHR As DrawingViewHatchRegion In oSecView.HatchRegions If oHR.Angle Then oHR.Angle = oAngle Next End If If oAngle = 0 Then GoTo SelectAngle Dim oMB3 = MessageBox.Show("Adjust Again (Yes) Options (No) Exit (Cancel)", "Hatch Properties", MessageBoxButtons.YesNoCancel, MessageBoxIcon.None, MessageBoxDefaultButton.Button2) If oMB3 = vbYes Then GoTo SelectAngle Else If oMB3 = vbNo Then GoTo Options1 Else If oMB3 = vbCancel Then Exit Sub End If End If '] '[ *** Select new scale *** SelectScale : Dim oScale As Double = 1 SelectScaleRep : Dim oScales As New List(Of Double) oScales.Add(10) '10:1 oScales.Add(2) '2:1 oScales.Add(1) '1:1 oScales.Add(0.5) '1:2 oScales.Add(0.25) '1:4 oScales.Add(0.2) '1:5 oScales.Add(0.1) '1:10 oScales.Add(0.05) '1:20 oScales.Add(0.04) '1:25 oScales.Add(0.02) '1:50 oScales.Add(0.01) '1:100 oScales.Add(0.005) '1:200 oScales.Add(0.002) '1:500 oScale = InputListBox("10:1 - 10" _ & vbCrLf & "2:1 - 2" _ & vbCrLf & "1:1 - 1" _ & vbCrLf & "1:2 - 0.5" _ & vbCrLf & "1:4 - 0.25" _ & vbCrLf & "1:5 - 0.2" _ & vbCrLf & "1:10 - 0.1" _ & vbCrLf & "1:20 - 0.05" _ & vbCrLf & "1:25 - 0.04" _ & vbCrLf & "1:50 - 0.02" _ & vbCrLf & "1:100 - 0.01" _ & vbCrLf & "1:200 - 0.005" _ & vbCrLf & "1:500 - 0.002", oScales, oScale, Title := "Hatch Properties", ListName := "Select New Scale") If oScale = 0 Then Exit Sub For Each oHR As DrawingViewHatchRegion In oSecView.HatchRegions If oHR.Scale Then oHR.Scale = oScale Next Dim oMB4 = MessageBox.Show("Adjust Again (Yes) Options (No) Exit (Cancel)", "Hatch Properties", MessageBoxButtons.YesNoCancel, MessageBoxIcon.None, MessageBoxDefaultButton.Button2) If oMB4 = vbYes Then GoTo SelectScaleRep Else If oMB4 = vbNo Then GoTo Options1 Else If oMB4 = vbCancel Then Exit Sub End If '] '[ *** Set hatch ByMaterial *** byMaterial : On Error Resume Next Dim oMB6 = MessageBox.Show("Do you really want to set all material hatches back to" _ & vbCrLf & "DEFAULT (Yes) Options (No) Exit (Cancel) ", " Hatch Properties ", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Warning, MessageBoxDefaultButton.Button2) If oMB6 = vbNo Then GoTo Options1 Else If oMB6 = vbCancel Then Exit Sub Else If oMB6 = vbYes Then For Each oHR As DrawingViewHatchRegion In oSecView.HatchRegions oHR.ByMaterial = True Logger.Info(oView.Name & ": HatechRegion.ByMaterial = " & oHR.ByMaterial) Next End If GoTo Options1 '] '[ *** Change pattern *** SelectPattern: oPattern = InputBox("Enter New Hatch Pattern." _ & vbCrLf & vbCrLf & "Note:- .", "Hatch Properties", "ANSI 31") If oPattern = "" Then GoTo Options1 Else On Error Resume Next For Each oHR As DrawingViewHatchRegion In oSecView.HatchRegions oHR.ByMaterial = False Logger.Info(oView.Name & ": HatechRegion.ByMaterial = " & oHR.ByMaterial) Next Dim oDoc As DrawingDocument = ThisDrawing.Document Dim oHPattern As DrawingHatchPattern oHPattern = oDoc.DrawingHatchPatternsManager.Item(oPattern) For Each oHR As DrawingViewHatchRegion In oSecView.HatchRegions oHR.Pattern = oHPattern Next Dim oMB5 = MessageBox.Show("Adjust Again (Yes) Options (No) Exit (Cancel)", "Hatch Properties", MessageBoxButtons.YesNoCancel, MessageBoxIcon.None, MessageBoxDefaultButton.Button2) If oMB5 = vbYes Then GoTo SelectPattern Else If oMB5 = vbNo Then GoTo Options1 Else If oMB5 = vbCancel Then Exit Sub End If End If End If '*** ROUTINE END *** '] '[ *** Error message *** ErrorMsg : MessageBox.Show("An Error Has Occured. Now exiting", "Hatch Properties",MessageBoxButtons.OK, MessageBoxIcon.Error) ' GoTo Options Exit Sub '] End Sub '[ *** Furtrher Options *** 'oHR.Angle 'Read/Write - Double 'oHR.ByMaterial 'Read/Write - Boolean 'oHR.Color 'Read/Write - Color object 'oHR.DoublePattern 'Read/Write - Boolean 'oHR.HatchAreas 'Read Only - DrawingViewHatchAreas object 'oHR.Layer 'Read/Write - Layer object 'oHR.LineWeight 'Read/Write - Double 'oHR.Pattern 'Read/Write - DrawingHatchPattern object 'oHR.Pattern = oDDoc.DrawingHatchPatternsManager.Item("ANSI 31") 'oHR.Scale 'Read/Write - Double 'oHR.Shift 'Read/Write - Double 'oHR.Visible 'Read/Write - Boolean ']