Hi all
I've made a program for setting all hatches in a drawing to be annotative.
This program traverses through all blocks and subblocks which you can't do with the quick select function.
The program worked well before AutoCAD mechanical version 2012. But now some hatches behave strange when they are changed to annotative hatches. They appear as solid hatches even though they are actually ANSI31. If you then toggle them back to non-annotative they some times revert to their normal state and sometimes remain as solid. I can’t figure out if there is a common denominator to the misbehaviour. And I don’t really know if it’s actually my program that does this.
Have any one experienced this behaviour with annotative hatch?
Can any one se if my program might cause this behaviour?
I have inserted the code so you can see what I’m doing.
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Internal
Imports Autodesk.AutoCAD.ApplicationServices
'Imports Autodesk.AutoCAD.Interop
Namespace ACADTools
Public Module Annotate
Public Sub AddScale(ByVal paperUnit As Double, ByVal drawingUnit As Double)
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Try
Dim ocm As ObjectContextManager = db.ObjectContextManager
If ocm IsNot Nothing Then
' Now get the Annotation Scaling context collection
' (named ACDB_ANNOTATIONSCALES_COLLECTION)
Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
If (occ IsNot Nothing) Then
'// Create a brand new scale context
Dim asc As AnnotationScale = New AnnotationScale()
asc.Name = paperUnit.ToString() & ":" & drawingUnit.ToString()
asc.PaperUnits = paperUnit
asc.DrawingUnits = drawingUnit
'// Add it to the drawing's context collection
occ.AddContext(asc)
End If
End If
Catch ex As System.Exception
SendMessage(ex.ToString())
End Try
End Sub
Public Sub RemoveAnnotativeHatch()
ThisDrawing.StartUndoMark()
Dim oHatch As AcadHatch
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim ocm As ObjectContextManager = db.ObjectContextManager
Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
Dim tr As Transaction = doc.TransactionManager.StartTransaction()
Dim blockstoignore() As String = InputBox("Please write Block names to ignore (comma seperated)", "Block to ignore", "HT logo*,_*,*Border*,*Head*,*Drawing*").Split(",")
Dim ignoreblock As Boolean
For Each oBlock As AcadBlock In ThisDrawing.Blocks
For Each blockname As String In blockstoignore
If oBlock.Name.ToLower.Trim Like blockname.ToLower.Trim Then ignoreblock = True
Next
If Not ignoreblock Then
For Each oAcadObject As AcadObject In oBlock
If TypeOf (oAcadObject) Is AcadHatch Then
oHatch = CType(oAcadObject, AcadHatch)
Dim obj As DBObject = tr.GetObject(New ObjectId(New IntPtr(oAcadObject.ObjectID)), OpenMode.ForRead)
If (obj IsNot Nothing) Then
obj.UpgradeOpen()
obj.Annotative = AnnotativeStates.False
End If
End If
Next
End If
ignoreblock = False
Next
tr.Commit()
'End Using
ThisDrawing.EndUndoMark()
End Sub
Public Sub AttachScale()
ThisDrawing.StartUndoMark()
Dim oHatch As AcadHatch
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim ocm As ObjectContextManager = db.ObjectContextManager
Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
Dim tr As Transaction = doc.TransactionManager.StartTransaction()
Dim Scales() As String = InputBox("Please write Scales (comma seperated)", "Scales to add", "2:1,1:1,1:2,1:2.5,1:4,1:5,1:7,1:7.5,1:10,1:12,1:12.5,1:15,1:20,1:25,1:33.33,1:50,1:75,1:100").Split(",")
Dim blockstoignore() As String = InputBox("Please write Block names to ignore (comma seperated)", "Block to ignore", "HT logo*,_*,*Border*,*Drawing*").Split(",")
For Each scale As String In Scales
Dim oc As ObjectContext = occ.GetContext(scale.Trim())
If oc Is Nothing Then AddScale(scale.Split(":")(0), scale.Split(":")(1))
Next
Dim ignoreblock As Boolean
For Each oBlock As AcadBlock In ThisDrawing.Blocks
For Each blockname As String In blockstoignore
If oBlock.Name.ToLower.Trim Like blockname.ToLower.Trim Then ignoreblock = True
Next
If Not ignoreblock Then
For Each oAcadObject As AcadObject In oBlock
If TypeOf (oAcadObject) Is AcadHatch Then
oHatch = CType(oAcadObject, AcadHatch)
If oHatch.PatternName = "ANSI31" Or oHatch.PatternName = "LINE" Then
Dim obj As DBObject = tr.GetObject(New ObjectId(New IntPtr(oAcadObject.ObjectID)), OpenMode.ForRead)
If (obj IsNot Nothing) Then
obj.UpgradeOpen()
obj.Annotative = AnnotativeStates.True
For Each scale As String In Scales
Try
ObjectContexts.AddContext(obj, occ.GetContext(scale.Trim()))
Catch
SendMessage(scale & " not found")
End Try
Next
End If
End If
End If
Next
End If
ignoreblock = False
Next
tr.Commit()
'End Using
ThisDrawing.EndUndoMark()
End Sub
End Module
End Namespace
