topic Re: DIMBLK ObjectID for Closed Filled Arrow in .NET Forum

DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Tue, 23 Feb 2016 16:55:36 GMT

I've been up and down the dial on this one and have not found how to purposely, through .net, set DIMBLK1 to a closed filled arrow. Setting DIMBLK to "." or "" doesn't return an obectid to use in RotatedDimension.Dimbl1 because it has no name to use in ObjId = bt(arrowname). Has anyonefound how to get this objectid or how to apply it a specific instance of a dimension?

Re: DIMBLK ObjectID for Closed Filled Arrow

Virupaksha_aithal — Wed, 24 Feb 2016 05:10:34 GMT

Hi,

does the blog item http://adndevblog.typepad.com/autocad/2012/11/setting-different-arrow-heads-for-dimension-style.html helps?

Re: DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Thu, 25 Feb 2016 19:30:47 GMT

No help at that blog, been through that blog previously as my op implies. Specific to the ClosedFilled arrow is needed as it is handled differently.

Re: DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Thu, 25 Feb 2016 22:12:25 GMT

Hi,

I have done this some times ago but I do not have source coding with my right now.

If I remember correctly for closed fillet arrow ObjectId=0

Richard

Re: DIMBLK ObjectID for Closed Filled Arrow

net_bat — Fri, 26 Feb 2016 05:42:48 GMT

You may set the System variable "DIMBLK" as “.”

Autodesk.AutoCAD.ApplicationServices.Application.SetSystemVariable("DIMBLK",“.”);

Re: DIMBLK ObjectID for Closed Filled Arrow

kerry_w_brown — Fri, 26 Feb 2016 07:40:54 GMT

Ron_M wrote:

I've been up and down the dial on this one and have not found how to purposely, through .net, set DIMBLK1 to a closed filled arrow. Setting DIMBLK to "." or "" doesn't return an obectid to use in RotatedDimension.Dimbl1 because it has no name to use in ObjId = bt(arrowname). Has anyonefound how to get this objectid or how to apply it a specific instance of a dimension?

What are you trying to do ??

Just reset the DIMBLK value ?

Define a new dimension style ?

Override an existing definition ?

Modify an existing dimension ?

Re: DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Fri, 26 Feb 2016 12:54:10 GMT

I'm overriding an existing dim style.

As the closed filled arrow has no name I'm unable to pull the object id using something like below because I can't pass a name "arrow" to the function.

    Private Shared Function GetArrowObjectId(arrow As String, newArrName As String) As ObjectId
        Dim arrObjId As ObjectId = ObjectId.Null
        Dim AcDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
        Dim AcDb As Database = AcDoc.Database
        Dim oldArrName As String = TryCast(Core.Application.GetSystemVariable(arrow), String)
        Core.Application.SetSystemVariable(arrow, newArrName)
        If oldArrName.Length <> 0 Then
            Core.Application.SetSystemVariable(arrow, oldArrName)
        End If
        Using Trans As Transaction = AcDb.TransactionManager.StartTransaction()
            Dim bt As BlockTable = DirectCast(Trans.GetObject(AcDb.BlockTableId, OpenMode.ForRead), BlockTable)
            arrObjId = bt(newArrName)
            Trans.Commit()
        End Using
        Return arrObjId
    End Function

Re: DIMBLK ObjectID for Closed Filled Arrow

kerry_w_brown — Sat, 27 Feb 2016 08:00:52 GMT

I've posted here :

https://www.theswamp.org/index.php?topic=50998.msg561270

re the image: The empty dimblk names and null ID's are for the default 'Closed filled' arrow.

Regards,

Re: DIMBLK ObjectID for Closed Filled Arrow

kerry_w_brown — Sat, 12 Mar 2016 23:45:45 GMT

You're welcome.

Re: DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Mon, 14 Mar 2016 17:52:47 GMT

For?

Re: DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Wed, 18 May 2016 18:47:43 GMT



Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime
Public Class Slope

#Region " Public Propties"
    Property AcDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
    Property AcDb As Database = AcDoc.Database
    Property AcEd As Editor = AcDoc.Editor
    Property BlkTab As BlockTable
    Property BlkTabRec As BlockTableRecord
    Property per1 As PromptEntityResult
    Property per1id As ObjectId
    Property OrigDimStyle As String = Core.Application.GetSystemVariable("dimstyle")
    Property Origlayer As String = Core.Application.GetSystemVariable("clayer")
    Property Origosmode As Double = Core.Application.GetSystemVariable("osmode")
    Property OOrthomode As Double = Core.Application.GetSystemVariable("orthomode")

#End Region

    <CommandMethod("slp")>
    Public Sub slopearrow()

        Dim pt(0 To 18) As Point3d
        Dim pts(0 To 7) As Point3d

        Dim peo1 As PromptNestedEntityOptions = New PromptNestedEntityOptions(vbLf & "Pick the sloped line or polyline segment: ")
        peo1.AllowNone = True
        Dim per1 As PromptNestedEntityResult = AcEd.GetNestedEntity(peo1)
        If per1.Status <> PromptStatus.OK Then
            Exit Sub
        Else
            per1id = per1.ObjectId
        End If

        AddLayer()

        Using (AcDoc.LockDocument)
            Using Trans As Transaction = AcDb.TransactionManager.StartTransaction
                Dim x1 As Double = Nothing, x2 As Double = Nothing
                Dim y1 As Double = Nothing, y2 As Double = Nothing
                Dim PtMid As New Point3d, Pt1 As New Point3d, PT2 As New Point3d
                Dim MidPt As New DBPoint, PtA As New DBPoint, PtB As New DBPoint
                Dim line1 As Line = Nothing
                Dim LineAng As String = Nothing
                PtMid = Nothing
                Pt1 = Nothing
                PT2 = Nothing
                MidPt = Nothing
                PtA = Nothing
                PtB = Nothing

                Dim ent As Entity = Trans.GetObject(per1id, OpenMode.ForRead)
                AcDb.Dimblk = ObjectId.Null
                If TypeOf ent Is Line Then
                    line1 = ent
                    LineAng = line1.Angle.ToString
                ElseIf TypeOf ent Is Polyline Then
                    Dim wcsPickedPoint As Point3d = per1.PickedPoint.TransformBy(AcEd.CurrentUserCoordinateSystem)
                    Dim pline As Polyline = DirectCast(Trans.GetObject(per1.ObjectId, OpenMode.ForRead), Polyline)
                    Dim pointOnPline As Point3d =
        If(per1.GetContainers().Length = 0,
            pline.GetClosestPointTo(wcsPickedPoint, False),
            pline.GetClosestPointTo(wcsPickedPoint.TransformBy(per1.Transform.Inverse()), False))

                    ' Get the selected segment index.
                    Dim segmentIndex As Integer = pline.GetParameterAtPoint(pointOnPline)
                    Dim PSeg As LineSegment2d = pline.GetLineSegment2dAt(segmentIndex)
                    Dim p1x As Double = PSeg.StartPoint.X
                    Dim p1y As Double = PSeg.StartPoint.Y
                    Dim p2x As Double = PSeg.EndPoint.X
                    Dim p2y As Double = PSeg.EndPoint.Y
                    line1 = New Line(New Point3d(p1x, p1y, 0), New Point3d(p2x, p2y, 0))
                    LineAng = line1.Angle.ToString
                End If

                pt(1) = line1.StartPoint
                pt(2) = line1.EndPoint

                If line1.StartPoint.X < line1.EndPoint.X And line1.StartPoint.Y < line1.EndPoint.Y Then
                    '1
                    AddLayer()
                    PtMid = New Point3d((pt(1).X + pt(2).X) / 2, (pt(1).Y + pt(2).Y) / 2, 0)
                    MidPt = New DBPoint(PtMid)
                    x1 = PtMid.X - (1 * Math.Cos(LineAng))
                    y1 = PtMid.Y - (1 * Math.Sin(LineAng))
                    x2 = PtMid.X + (1 * Math.Cos(LineAng))
                    y2 = PtMid.Y + (1 * Math.Sin(LineAng))
                    Pt1 = New Point3d(x1, y1, 0)
                    PtA = New DBPoint(Pt1)
                    PT2 = New Point3d(x2, y2, 0)
                    PtB = New DBPoint(PT2)

                    '2
                ElseIf line1.StartPoint.X > line1.EndPoint.X And line1.StartPoint.Y < line1.EndPoint.Y Then
                    AddLayer()
                    PtMid = New Point3d((pt(1).X + pt(2).X) / 2, (pt(1).Y + pt(2).Y) / 2, 0)
                    MidPt = New DBPoint(PtMid)
                    x1 = PtMid.X - (1 * Math.Cos(LineAng))
                    y1 = PtMid.Y - (1 * Math.Sin(LineAng))
                    x2 = PtMid.X + (1 * Math.Cos(LineAng))
                    y2 = PtMid.Y + (1 * Math.Sin(LineAng))
                    Pt1 = New Point3d(x1, y1, 0)
                    PtA = New DBPoint(Pt1)
                    PT2 = New Point3d(x2, y2, 0)
                    PtB = New DBPoint(PT2)

                    '3
                ElseIf line1.StartPoint.X > line1.EndPoint.X And line1.StartPoint.Y > line1.EndPoint.Y Then
                    AddLayer()
                    PtMid = New Point3d((pt(1).X + pt(2).X) / 2, (pt(1).Y + pt(2).Y) / 2, 0)
                    MidPt = New DBPoint(PtMid)
                    x1 = PtMid.X + (1 * Math.Cos(LineAng))
                    y1 = PtMid.Y + (1 * Math.Sin(LineAng))
                    x2 = PtMid.X - (1 * Math.Cos(LineAng))
                    y2 = PtMid.Y - (1 * Math.Sin(LineAng))
                    Pt1 = New Point3d(x1, y1, 0)
                    PtA = New DBPoint(Pt1)
                    PT2 = New Point3d(x2, y2, 0)
                    PtB = New DBPoint(PT2)

                    '4
                ElseIf line1.StartPoint.X < line1.EndPoint.X And line1.StartPoint.Y > line1.EndPoint.Y Then
                    AddLayer()
                    PtMid = New Point3d((pt(1).X + pt(2).X) / 2, (pt(1).Y + pt(2).Y) / 2, 0)
                    MidPt = New DBPoint(PtMid)
                    x1 = PtMid.X + (1 * Math.Cos(LineAng))
                    y1 = PtMid.Y + (1 * Math.Sin(LineAng))
                    x2 = PtMid.X - (1 * Math.Cos(LineAng))
                    y2 = PtMid.Y - (1 * Math.Sin(LineAng))
                    Pt1 = New Point3d(x1, y1, 0)
                    PtA = New DBPoint(Pt1)
                    PT2 = New Point3d(x2, y2, 0)
                    PtB = New DBPoint(PT2)

                    BlkTab = Trans.GetObject(AcDb.BlockTableId, OpenMode.ForRead)
                    BlkTabRec = Trans.GetObject(BlkTab(BlockTableRecord.ModelSpace), OpenMode.ForWrite)

                End If
                Trans.Commit()
                AddArrow(Pt1, PT2, PtMid, LineAng)
            End Using
        End Using

    End Sub

    Public Sub AddArrow(Pt1 As Point3d, Pt2 As Point3d, PtMid As Point3d, LineAng As Double)
        Using (AcDoc.LockDocument)
            Using Trans As Transaction = AcDb.TransactionManager.StartTransaction
                BlkTab = Trans.GetObject(AcDb.BlockTableId, OpenMode.ForWrite)
                BlkTabRec = Trans.GetObject(BlkTab(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                Dim OldDimBlk1 As String = Core.Application.GetSystemVariable("dimblk")
                Core.Application.SetSystemVariable("DIMBLK", "closed")
                Core.Application.SetSystemVariable("DIMBLK", ".")

                BlkTab = Trans.GetObject(AcDb.BlockTableId, OpenMode.ForWrite)
                BlkTabRec = Trans.GetObject(BlkTab(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                Dim arrowname As String = DirectCast(Core.Application.GetSystemVariable("DIMBLK"), String)
                Dim id1 As ObjectId = GetArrowObjectId("DIMBLK", ".")
                Dim id2 As ObjectId = GetArrowObjectId("DIMBLK2", "_NONE")
                Using RotDim As RotatedDimension = New RotatedDimension
                    RotDim.XLine1Point = New Point3d(Pt1.X, Pt1.Y, 0)
                    RotDim.XLine2Point = New Point3d(Pt2.X, Pt2.Y, 0)
                    RotDim.Rotation = LineAng
                    RotDim.DimLinePoint = New Point3d(PtMid.X, PtMid.Y, 0)
                    RotDim.DimensionStyle = AcDb.Dimstyle
                    Dim DimObj As Dimension = RotDim
                    DimObj.Dimtad = 1
                    DimObj.DimensionText = "SLOPE"
                    DimObj.Dimdli = 2
                    DimObj.Dimfxlen = 0.125
                    RotDim.Dimsah = True
                    RotDim.Dimblk1 = id1
                    RotDim.Dimblk2 = id2
                    BlkTabRec.AppendEntity(RotDim)
                    Trans.AddNewlyCreatedDBObject(RotDim, True)

                End Using
                Trans.Commit()
            End Using
        End Using
    End Sub

    Public Sub AddLayer()
        Using (AcDoc.LockDocument())
            Using Trans As Transaction = AcDb.TransactionManager.StartTransaction()
                Dim laytb As LayerTable = Trans.GetObject(AcDb.LayerTableId, OpenMode.ForRead)
                If laytb.Has("NOTE") = True Then
                    Dim oldlayer As LayerTableRecord
                    oldlayer = Trans.GetObject(laytb("NOTE"), OpenMode.ForWrite)
                    If oldlayer.IsFrozen = True Then
                        oldlayer.IsFrozen = False
                    End If
                    If oldlayer.IsLocked = True Then
                        oldlayer.IsLocked = False
                    End If
                    If oldlayer.IsOff = True Then
                        oldlayer.IsOff = False
                    End If
                    If oldlayer.IsHidden = True Then
                        oldlayer.IsHidden = False
                    End If
                Else
                    If laytb.Has("NOTE") = False Then
                        Dim newlayer As LayerTableRecord = New LayerTableRecord()
                        newlayer.Name = "NOTE"
                        newlayer.LineWeight = LineWeight.LineWeight005
                        newlayer.Color = Color.FromColorIndex(ColorMethod.ByAci, 1)
                        laytb.UpgradeOpen()
                        laytb.Add(newlayer)
                        Trans.AddNewlyCreatedDBObject(newlayer, True)
                        Dim lintb As LinetypeTable
                        lintb = Trans.GetObject(AcDb.LinetypeTableId, OpenMode.ForRead)
                        If lintb.Has("CONTINUOUS") = False Then
                            AcDb.LoadLineTypeFile("CONTINUOUS", "acad.lin")
                        End If
                        laytb.UpgradeOpen()
                        newlayer.LinetypeObjectId = lintb("CONTINUOUS")
                    End If
                End If
                Trans.Commit()
                AcDb.Clayer = laytb("NOTE")
                AcEd.Regen()
            End Using
        End Using
    End Sub

    Private Shared Function GetArrowObjectId(arrow As String, newArrName As String) As ObjectId
        Dim arrObjId As ObjectId = ObjectId.Null
        Dim AcDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
        Dim AcDb As Database = AcDoc.Database
        Dim oldArrName As String = TryCast(Core.Application.GetSystemVariable(arrow), String)
        Core.Application.SetSystemVariable(arrow, newArrName)
        If oldArrName.Length <> 0 Then
            Core.Application.SetSystemVariable(arrow, oldArrName)
        End If
        Using Trans As Transaction = AcDb.TransactionManager.StartTransaction()
            Dim bt As BlockTable = DirectCast(Trans.GetObject(AcDb.BlockTableId, OpenMode.ForRead), BlockTable)
            If String.IsNullOrEmpty(newArrName) OrElse newArrName.Equals(".") Then
                Return ObjectId.Null
            Else
                arrObjId = bt(newArrName)
            End If
            Trans.Commit()
        End Using
        Return arrObjId
    End Function

End Class

I've still not managed to get this working. I'm creating a slope arrow that is applied when line is selected. As the code sits now the arrow on the down side remains "ARCHTICK" when I want it to be a closed arrow.

Re: DIMBLK ObjectID for Closed Filled Arrow

Virupaksha_aithal — Wed, 25 May 2016 07:44:11 GMT

Hi,

can you try with below "AddArrow" instead of your code?

Public Sub AddArrow(Pt1 As Point3d, Pt2 As Point3d, PtMid As Point3d, LineAng As Double)
            Using (AcDoc.LockDocument)
                Dim id1 As ObjectId = GetArrowObjectId("DIMBLK1", "_Closed")
                Dim id2 As ObjectId = GetArrowObjectId("DIMBLK2", "_NONE")

                Using Trans As Transaction = AcDb.TransactionManager.StartTransaction
                    BlkTab = Trans.GetObject(AcDb.BlockTableId, OpenMode.ForRead)
                    BlkTabRec = Trans.GetObject(BlkTab(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                    Using RotDim As RotatedDimension = New RotatedDimension
                        RotDim.XLine1Point = New Point3d(Pt1.X, Pt1.Y, 0)
                        RotDim.XLine2Point = New Point3d(Pt2.X, Pt2.Y, 0)
                        RotDim.Rotation = LineAng
                        RotDim.DimLinePoint = New Point3d(PtMid.X, PtMid.Y, 0)
                        RotDim.DimensionStyle = AcDb.Dimstyle
                        Dim DimObj As Dimension = RotDim
                        DimObj.Dimtad = 1
                        DimObj.DimensionText = "SLOPE"
                        DimObj.Dimdli = 2
                        DimObj.Dimfxlen = 0.125
                        RotDim.Dimsah = True
                        RotDim.Dimblk1 = id1
                        RotDim.Dimblk2 = id2
                        BlkTabRec.AppendEntity(RotDim)
                        Trans.AddNewlyCreatedDBObject(RotDim, True)
                    End Using
                    Trans.Commit()
                End Using
            End Using
        End Sub

Re: DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Wed, 25 May 2016 12:25:14 GMT

Creates a closed but not closed filled arrow.

Re: DIMBLK ObjectID for Closed Filled Arrow

Virupaksha_aithal — Thu, 26 May 2016 05:37:06 GMT

Hi,

Please replace the code

Dim id1 As ObjectId = GetArrowObjectId("DIMBLK1", "_Closed")

with

Dim id1 As ObjectId = GetArrowObjectId("DIMBLK1", "")

For closed filled style, just pass empty as block name. Hopefully this works and adds closed filled arrow head

Re: DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Thu, 26 May 2016 13:05:50 GMT

Tried even though I've already been there as shown in previous posts. Does not work. Pulls in the current which is archtick. I've also tried setting DIMBLK to "" and " " and "." prior to getting the objectid of DIMBLK1. I've also tried to go direct by setting RotDim.Dimblk1 = 0 as directed by a previous post.

Re: DIMBLK ObjectID for Closed Filled Arrow

Virupaksha_aithal — Fri, 27 May 2016 09:03:27 GMT

Hi,

But by providing “” as block name, AutoCAD is able to create the closed arrowhead (with filled) at my end. Refer Screen cast http://autode.sk/25lP00w

Re: DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Fri, 27 May 2016 10:06:56 GMT

What arrowhead are you starting out with as DIMBLK, DIMBLK1 & DIMBLK2? I'm starting with an established DIMSTYLE that uses ARCH_TICK as the arrow. Would you post your code for comparison?

Re: DIMBLK ObjectID for Closed Filled Arrow

Virupaksha_aithal — Tue, 31 May 2016 05:55:50 GMT

Hi,

I was trying with standard template file (which will have DIMBLK, DIMBLK1, DIMBLK2 as “”). Now I have tried with DIMBLK, DIMBLK1, DIMBLK2 as ARCH_TICK. With below code (only change I have made in code provided by you), AutoCAD is able to set the closed filled arrow as DIMBLK1. Refer http://autode.sk/1Y0pNXu

        Public Sub AddArrow(Pt1 As Point3d, Pt2 As Point3d, PtMid As Point3d, LineAng As Double)
            Using (AcDoc.LockDocument)
                Dim id1 As ObjectId = GetArrowObjectId("DIMBLK1", ".")
                Dim id2 As ObjectId = GetArrowObjectId("DIMBLK2", "_NONE")

                Using Trans As Transaction = AcDb.TransactionManager.StartTransaction
                    BlkTab = Trans.GetObject(AcDb.BlockTableId, OpenMode.ForRead)
                    BlkTabRec = Trans.GetObject(BlkTab(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                    Using RotDim As RotatedDimension = New RotatedDimension
                        RotDim.XLine1Point = New Point3d(Pt1.X, Pt1.Y, 0)
                        RotDim.XLine2Point = New Point3d(Pt2.X, Pt2.Y, 0)
                        RotDim.Rotation = LineAng
                        RotDim.DimLinePoint = New Point3d(PtMid.X, PtMid.Y, 0)
                        RotDim.DimensionStyle = AcDb.Dimstyle
                        Dim DimObj As Dimension = RotDim
                        DimObj.Dimtad = 1
                        DimObj.DimensionText = "SLOPE"
                        DimObj.Dimdli = 2
                        DimObj.Dimfxlen = 0.125
                        RotDim.Dimsah = True
                        RotDim.Dimblk1 = id1
                        RotDim.Dimblk2 = id2
                        BlkTabRec.AppendEntity(RotDim)
                        
                        Trans.AddNewlyCreatedDBObject(RotDim, True)
                    End Using
                    Trans.Commit()
                End Using
            End Using
        End Sub

Re: DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Tue, 31 May 2016 13:10:32 GMT

Copy/paste your code in. Still no joy. Will look into this further this afternoon.

Re: DIMBLK ObjectID for Closed Filled Arrow

Anonymous — Tue, 31 May 2016 18:05:33 GMT

It all appears to be based on our templates. Within it, to facilitate creation of sheets we've set the default DIMBLK to ARCHTICK. Even though the code changes that in variable it doesn't in practice. Starting with the stock template, DIMBLK set to "", it works.