Hello everybody,
I'm upgrading some VBA macros for AutoCAD 2004 to .Net in AutoCAD 2008, but I'm having some problems with the Hatch Object.
I've noticed that AutoCAD in the managed environment of Visual Studio 2005 builds the Hatch but some properties are not working.
The PatternScale and The PatternAngle are created with my values, but the display of those objects is not correct. If I check them
through the properties tool or even with a simple "LIST" command, the values are correct but they don't reflect the display.
If I change those values in the editor and reset them as to my values then I get the correct display.
Another thing that's not working correctly is the Area property, that returns always "eInvalidInput" when reading it in the development
environment.
I'm wondering if ti's a bug or if my code is wrong, any help, corrections or hints is appreciated.
Following I'm posting the body of a sample application that recreates the problems.
I'm also attaching the project made for this post, just in case any wants to test it.
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Public Class reneramClass
' Define command HatchTestA - Square Inside Square with Area = 300
<CommandMethod("HatchTestA")> _
Public Sub HatchTestA()
Dim myPoints As New Geometry.Point3dCollection
' Set the points of a 20,20 square
myPoints.Add(New Geometry.Point3d(0, 0, 0))
myPoints.Add(New Geometry.Point3d(20, 0, 0))
myPoints.Add(New Geometry.Point3d(20, 20, 0))
myPoints.Add(New Geometry.Point3d(0, 20, 0))
' Add the 1st square to the drawing
AddPolyline(myPoints)
myPoints.Clear()
' Set the points for an internal 10,10 square
myPoints.Add(New Geometry.Point3d(5, 5, 0))
myPoints.Add(New Geometry.Point3d(15, 5, 0))
myPoints.Add(New Geometry.Point3d(15, 15, 0))
myPoints.Add(New Geometry.Point3d(5, 15, 0))
' Add the 2nd square to the drawing
AddPolyline(myPoints)
' Create the Hatch
Dim mySS As Autodesk.AutoCAD.EditorInput.SelectionSet
mySS = SSLayer("0")
' Start debug here:
' Hatch(Area Is 300)
' Hatch Representation is not correct:
' Pattern Scale is "1" but looking in the properties through the editor
' it's reported as "0.5"
' Patern Angle is "0" but looking n the properties through the editor
' it's reported as "58"
AddHatch(mySS, , 0.5, 45.0, , True)
End Sub
' Define command HatchTestB - Square Intersecting Square with Area = 400
<CommandMethod("HatchTestB")> _
Public Sub HatchTestB()
Dim myPoints As New Geometry.Point3dCollection
' Set the points of a 20,20 square
myPoints.Add(New Geometry.Point3d(0, 0, 0))
myPoints.Add(New Geometry.Point3d(20, 0, 0))
myPoints.Add(New Geometry.Point3d(20, 20, 0))
myPoints.Add(New Geometry.Point3d(0, 20, 0))
' Add the 1st square to the drawing
AddPolyline(myPoints)
myPoints.Clear()
' Set the points for an intersecting 10,10 square
myPoints.Add(New Geometry.Point3d(15, 5, 0))
myPoints.Add(New Geometry.Point3d(25, 5, 0))
myPoints.Add(New Geometry.Point3d(25, 15, 0))
myPoints.Add(New Geometry.Point3d(15, 15, 0))
' Add the 2nd square to the drawing
AddPolyline(myPoints)
' Create the Hatch
Dim mySS As Autodesk.AutoCAD.EditorInput.SelectionSet
mySS = SSLayer("0")
' Start debug here:
' Hatch(Area Is 400)
' Hatch Representation is not correct:
' Pattern Scale is "1" but looking in the properties through the editor
' it's reported as "0.5"
' Patern Angle is "0" but looking n the properties through the editor
' it's reported as "58"
AddHatch(mySS, , 0.5, 45.0, , True)
End Sub
' Define command HatchTestC - Two separate Squares with total Area = 500
<CommandMethod("HatchTestC")> _
Public Sub HatchTestC()
Dim myPoints As New Geometry.Point3dCollection
' Set the points of a 20,20 square
myPoints.Add(New Geometry.Point3d(0, 0, 0))
myPoints.Add(New Geometry.Point3d(20, 0, 0))
myPoints.Add(New Geometry.Point3d(20, 20, 0))
myPoints.Add(New Geometry.Point3d(0, 20, 0))
' Add the 1st square to the drawing
AddPolyline(myPoints)
myPoints.Clear()
' Set the points for an external 10,10 square
myPoints.Add(New Geometry.Point3d(35, 5, 0))
myPoints.Add(New Geometry.Point3d(45, 5, 0))
myPoints.Add(New Geometry.Point3d(45, 15, 0))
myPoints.Add(New Geometry.Point3d(35, 15, 0))
' Add the 2nd square to the drawing
AddPolyline(myPoints)
' Create the Hatch
Dim mySS As Autodesk.AutoCAD.EditorInput.SelectionSet
mySS = SSLayer("0")
' Start debug here:
' Hatch(Area Is 500)
' Hatch Representation is not correct:
' Pattern Scale is "1" but looking in the properties through the editor
' it's reported as "0.5"
' Patern Angle is "0" but looking n the properties through the editor
' it's reported as "58"
AddHatch(mySS, , 0.5, 45.0, , True)
End Sub
' Add a Polyline
Sub AddPolyline(ByVal PlinePoints As Geometry.Point3dCollection)
Dim myTransMan As DatabaseServices.TransactionManager
Dim myTrans As DatabaseServices.Transaction
Dim myDWG As ApplicationServices.Document
Dim myBT As DatabaseServices.BlockTable
Dim myBTR As DatabaseServices.BlockTableRecord
'Get the active document and begin a Transaction
myDWG = ApplicationServices.Application.DocumentManager.MdiActiveDocument
myTransMan = myDWG.TransactionManager
myTrans = myTransMan.StartTransaction
'Open the BlockTable for Read
myBT = myDWG.Database.BlockTableId.GetObject( _
DatabaseServices.OpenMode.ForRead)
myBTR = myBT(DatabaseServices.BlockTableRecord.ModelSpace).GetObject( _
DatabaseServices.OpenMode.ForWrite)
' Draw the Polyline
Dim myPLine As New DatabaseServices.Polyline2d(Poly2dType.SimplePoly, _
PlinePoints, 0, True, 0, 0, Nothing)
myBTR.AppendEntity(myPLine)
myTrans.AddNewlyCreatedDBObject(myPLine, True)
'Commit the Transaction
myTrans.Commit()
myTrans.Dispose()
myTransMan.Dispose()
End Sub
' Add a Hatch
Sub AddHatch(ByVal HatchLoops As Autodesk.AutoCAD.EditorInput.SelectionSet, _
Optional ByVal HatchPattern As String = "ANSI31", _
Optional ByVal HatchScale As Double = 1, _
Optional ByVal HatchAngle As Double = 0, _
Optional ByVal ACIColor As Short = 256, _
Optional ByVal HatchIsAssociative As Boolean = True)
Dim myDB As DatabaseServices.Database
Dim myDWG As ApplicationServices.Document
Dim myTrans As Transaction
Dim myTransMan As DatabaseServices.TransactionManager
Dim myEd As EditorInput.Editor
Dim myObjIds As DatabaseServices.ObjectIdCollection
Dim myObjId As DatabaseServices.ObjectId
Dim myBT As DatabaseServices.BlockTable
Dim myBTR As DatabaseServices.BlockTableRecord
Dim myHatch As Hatch 'the hatch object
Dim myHatchLoops As ObjectIdCollection ' collection of IDs of the hatch loops
Dim HatchArea As Double 'place holder for messagebox
myDWG = ApplicationServices.Application.DocumentManager.MdiActiveDocument
myTransMan = myDWG.TransactionManager
myTrans = myTransMan.StartTransaction
myDB = myDWG.Database
myEd = myDWG.Editor
' Get the IDs of the hatch loops
myObjIds = New ObjectIdCollection(HatchLoops.GetObjectIds)
' build the hatch
Try
' open the block table for read
myBT = myTrans.GetObject(myDB.BlockTableId, OpenMode.ForRead)
' create block table record for write
myBTR = myTrans.GetObject(myBT(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
' create the hatch
myHatch = New Autodesk.AutoCAD.DatabaseServices.Hatch
' add newly created hatch to block table record
myBTR.AppendEntity(myHatch)
' add the hatch BTR to the BT
myTrans.AddNewlyCreatedDBObject(myHatch, True)
' set hatch properties
' Pattern
myHatch.SetHatchPattern(HatchPatternType.PreDefined, HatchPattern)
' Hatch Pattern Scale
myHatch.PatternScale = HatchScale
' Hatch Pattern Angle
myHatch.PatternAngle = HatchAngle
' Color
myHatch.ColorIndex = CInt(ACIColor)
myHatch.Normal = New Geometry.Vector3d(0, 0, 1)
myHatch.Elevation = 0.0
' Hatch is Associative
If HatchIsAssociative Then
myHatch.Associative = True ' hatch is associative
End If
' append hatch loops
For Each myObjId In myObjIds
myHatchLoops = New ObjectIdCollection
myHatchLoops.Add(myObjId)
myHatch.AppendLoop(HatchLoopTypes.Default, myHatchLoops)
Next
' Update the newly created hatch
myHatch.EvaluateHatch(False)
'Get the Hatch Area
' Comment the following line when testing Hatch Scale
HatchArea = myHatch.Area '<= eInvalidInput error
myTrans.Commit()
myBT.Dispose()
myBTR.Dispose()
Catch ex As System.Exception
MsgBox(ex.Message) '<= eInvalidInput Message
' Add the hatch in any case
myTrans.Commit()
Finally
myEd.Regen()
myTrans.Dispose()
myTransMan.Dispose()
End Try
' Display Hatch Area
MsgBox(HatchArea, MsgBoxStyle.Information, "Hatch Area")
End Sub
' Get SelectionSet of a Layer
Function SSLayer(ByVal LayerName As String) As EditorInput.SelectionSet
Dim myDB As DatabaseServices.Database
Dim myDWG As ApplicationServices.Document
Dim myTrans As Transaction
Dim myTransMan As DatabaseServices.TransactionManager
Dim myEd As EditorInput.Editor
Dim myPSR As EditorInput.PromptSelectionResult
Dim myFilter(0) As DatabaseServices.TypedValue
myFilter(0) = New DatabaseServices.TypedValue( _
DatabaseServices.DxfCode.LayerName, LayerName)
Dim mySF As New EditorInput.SelectionFilter(myFilter)
myDWG = ApplicationServices.Application.DocumentManager.MdiActiveDocument
myTransMan = myDWG.TransactionManager
myTrans = myTransMan.StartTransaction
myDB = myDWG.Database
myEd = myDWG.Editor
myPSR = myEd.SelectAll(mySF)
SSLayer = myPSR.Value
myTrans.Commit()
myTrans.Dispose()
myTransMan.Dispose()
Return SSLayer
End Function
End Class
Thanks in advance for any help!
René
