Message 1 of 6
A simple overrule snaps which either doesn't work or make crash
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello again. I hope this time somebody help me.
I tried to simplified everything .
Attached please find a a drawing for use with code. command is "onoff" to make over rule activate.
Problem is snaps doesn't like to work at all . I try to put a dimension line at end of overrule lines and either it crash or doen't like to grip the end point of line. And below is code. it is 2012 .
Thanks,
Janet.
Imports System.Math Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.Geometry Imports Autodesk.AutoCAD.GraphicsInterface Public Class MyOverRuleClass Public Shared MyXdataTablename = "My_Data" Public Shared BlockshapeOverrule As Block_XdataDrawOverrule Public Shared BlockOsnapOverrule As Block_XdataOsnapOverrule <CommandMethod("onoff")> _ Public Shared Sub StartMyOverrule() If BlockshapeOverrule Is Nothing Then BlockshapeOverrule = New Block_XdataDrawOverrule BlockOsnapOverrule = New Block_XdataOsnapOverrule Overrule.AddOverrule(RXClass.GetClass(GetType(BlockReference)), BlockshapeOverrule, True) Overrule.AddOverrule(RXClass.GetClass(GetType(BlockReference)), BlockOsnapOverrule, True) BlockshapeOverrule.SetXDataFilter(MyXdataTablename) BlockOsnapOverrule.SetXDataFilter(MyXdataTablename) Application.DocumentManager.MdiActiveDocument.Editor.Regen() Else Overrule.RemoveOverrule(RXClass.GetClass(GetType(BlockReference)), BlockshapeOverrule) BlockshapeOverrule.Dispose() BlockshapeOverrule = Nothing Application.DocumentManager.MdiActiveDocument.Editor.Regen() End If End Sub End Class Public Class Block_Dimension Inherits DrawableOverrule Public Overrides Function WorldDraw(ByVal drawable As Autodesk.AutoCAD.GraphicsInterface.Drawable, ByVal wd As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean Return False End Function End Class Public Class Block_XdataDrawOverrule Inherits DrawableOverrule Public Overrides Function WorldDraw(ByVal drawable As Autodesk.AutoCAD.GraphicsInterface.Drawable, ByVal wd As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean Return False End Function Public Overloads Overrides Sub ViewportDraw(ByVal drawable As Autodesk.AutoCAD.GraphicsInterface.Drawable, _ ByVal vd As Autodesk.AutoCAD.GraphicsInterface.ViewportDraw) Dim myDynamicBlock As BlockReference = drawable Dim BlockOffset1 As New BlockOffset Dim ListEnts As List(Of Entity) = BlockOffset1.Offset(myDynamicBlock) For Each Ent As Entity In ListEnts Ent.ViewportDraw(vd) Ent.Dispose() Next MyBase.ViewportDraw(drawable, vd) End Sub End Class Public Class Block_XdataOsnapOverrule Inherits OsnapOverrule Public Overrides Sub GetObjectSnapPoints(ByVal e As Entity, _ ByVal snapMode As ObjectSnapModes, _ ByVal gsSelectionMark As System.IntPtr, _ ByVal pickPoint As Point3d, _ ByVal lastPoint As Point3d, _ ByVal viewTransform As Matrix3d, _ ByVal snapPoints As Point3dCollection, _ ByVal geometryIds As IntegerCollection) Dim myDynamicBlock As BlockReference = TryCast(e, BlockReference) Dim BlockOffset1 As New BlockOffset Dim ListEnts As List(Of Entity) = BlockOffset1.Offset(myDynamicBlock) For Each SubEnt As Entity In ListEnts SubEnt.GetObjectSnapPoints(snapMode, gsSelectionMark, pickPoint, lastPoint, viewTransform, snapPoints, geometryIds) SubEnt.Dispose() Next MyBase.GetObjectSnapPoints(e, snapMode, gsSelectionMark, pickPoint, lastPoint, viewTransform, snapPoints, geometryIds) End Sub End Class Public Class BlockOffset Function Offset(ByVal MyBlock As BlockReference) As List(Of Entity) Offset = New List(Of Entity) Dim List_Entities As List(Of Entity) = GetBlockEntities(MyBlock) Dim line1 As New Line line1 = TryCast(List_Entities(0), Line) Dim MyPolyLine1 As Autodesk.AutoCAD.DatabaseServices.Polyline = New Autodesk.AutoCAD.DatabaseServices.Polyline Dim MyPt1 As Point3d = PolarPoint(line1.StartPoint, line1.Angle + (0.5 * PI), 300) Dim MyPt2 As Point3d = PolarPoint(line1.StartPoint, line1.Angle - (0.5 * PI), 300) MyPolyLine1.AddVertexAt(0, New Point2d(MyPt1.X, MyPt1.Y), 0, 0, 0) MyPolyLine1.AddVertexAt(1, New Point2d(MyPt2.X, MyPt2.Y), 0, 0, 0) Offset.Add(TryCast(MyPolyLine1, Entity)) ' perpendicular line to block direction at beginning MyPolyLine1 = New Autodesk.AutoCAD.DatabaseServices.Polyline MyPt1 = PolarPoint(line1.StartPoint, line1.Angle, 200) MyPolyLine1.AddVertexAt(0, New Point2d(line1.StartPoint.X, line1.StartPoint.Y), 0, 0, 0) MyPolyLine1.AddVertexAt(1, New Point2d(MyPt1.X, MyPt1.Y), 0, 0, 0) MyPolyLine1.SetEndWidthAt(0, 100) Offset.Add(TryCast(MyPolyLine1, Entity)) ' arrow at begining End Function Shared Function GetBlockEntities(ByVal BR As BlockReference) As List(Of Entity) GetBlockEntities = New List(Of Entity) Dim acDBObjColl As DBObjectCollection = New DBObjectCollection() BR.Explode(acDBObjColl) For Each Ent As DBObject In acDBObjColl If TypeOf Ent Is Line Then Dim MyEntity As Entity = TryCast(Ent, Entity).Clone GetBlockEntities.Add(MyEntity) End If Next End Function Private Function PolarPoint(ByVal basepoint As Point3d, ByVal angle As Double, ByVal distance As Double) As Point3d Return New Point3d(basepoint.X + (distance * Cos(angle)), basepoint.Y + (distance * Sin(angle)), basepoint.Z) End Function End Class
Edited by
Discussion_Admin