Author Topic: Draw stacked dimensions for panel holes  (Read 706 times)

0 Members and 1 Guest are viewing this topic.

Offline fixo

  • Full Member
  • ***
  • Posts: 135
  • Karma: +4/-0
  • Gender: Male
    • prefered language: C
    • Prog expertise: Good
    • View Profile
Draw stacked dimensions for panel holes
« on: March 11, 2013, 08:13:12 PM »
For horizontal dimensions the first point is on left or right edge of panel,
for vertical dimensions it would be on top or bottom edge of panel for your choice

Code: [Select]
       #Region "Stacked Dimension"
        <CommandMethod("stackdim")> _
        Public Sub testDimStackHoles()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            Dim pko As New PromptKeywordOptions(vbLf & "Choose Dimension direction [Horizontal/Vertical]: ", "Horizontal Vertical")
            ' The default depends on our current settings
            pko.Keywords.Default = "Horizontal"
            Dim pres As PromptResult = ed.GetKeywords(pko)
            If pres.Status <> PromptStatus.OK Then
                Return
            End If
            Dim choice As String = pres.StringResult

            Dim spt As New Point3d
            Autodesk.AutoCAD.ApplicationServices.Application.SetSystemVariable("osmode", 513)
            If Not GetFirstPoint(ed, "Pick first point (press Enter to Exit loop): ", spt) Then Return
            Dim oids() As ObjectId = GetUserPickedObjects(doc, "Select circles: ")
            ed.Regen()
            doc.TransactionManager.EnableGraphicsFlush(True)
            Dim up As Double = db.Dimtxt * 4
            Using tr As Transaction = doc.Database.TransactionManager.StartTransaction()

                Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                Dim cnt As Integer = 0
                Dim ang As Double
                Dim rdim As RotatedDimension = Nothing
                For Each id As ObjectId In oids
                    If (Not id.ObjectClass.IsDerivedFrom(RXClass.GetClass(GetType(Circle)))) Then Continue For
                    Dim ent As DBObject = tr.GetObject(id, OpenMode.ForRead, False)
                    Dim circ As Circle = TryCast(ent, Circle)
                    If circ Is Nothing Then Return
                    Dim cp As Point3d = circ.Center
                    Dim gap As Double = cp.X - spt.X
                    If cnt = 0 Then
                        up = circ.Radius + up
                        If choice = "Horizontal" Then
                            spt = New Point3d(spt.X, cp.Y, spt.Z)
                        Else
                            spt = New Point3d(cp.X, spt.Y, spt.Z)
                        End If
                        cnt += 1
                    End If
                    If choice = "Horizontal" Then
                        ang = 0.0
                        rdim = New RotatedDimension(ang, spt, cp, spt + New Vector3d(0, up, 0), "", db.Dimstyle)
                    Else
                        ang = Math.PI / 2
                        rdim = New RotatedDimension(ang, spt, cp, spt - New Vector3d(up, 0, 0), "", db.Dimstyle)
                    End If
                    up += db.Dimtxt * 2
                    btr.AppendEntity(rdim)
                    tr.AddNewlyCreatedDBObject(rdim, True)
                    tr.TransactionManager.QueueForGraphicsFlush()
                Next
                doc.TransactionManager.FlushGraphics()
                tr.Commit()
                ed.UpdateScreen()
            End Using
        End Sub


        Private Shared Function GetUserPickedObjects(ByVal doc As Document, msg As String) As ObjectId()
            Dim ids As New List(Of ObjectId)
            Using tr As Transaction = doc.Database.TransactionManager.StartTransaction()
                Dim go As Boolean = True
                While go
                    go = False

                    Dim opt As New PromptEntityOptions(vbLf & msg)
                    Dim res As PromptEntityResult = doc.Editor.GetEntity(opt)

                    If res.Status = PromptStatus.OK Then
                        Dim exists As Boolean = False
                        For Each id As ObjectId In ids
                            If id = res.ObjectId Then
                                exists = True
                                Exit For
                            End If
                        Next

                        If Not exists Then
                            'Highlight
                            Dim ent As Entity = DirectCast(tr.GetObject(res.ObjectId, OpenMode.ForWrite), Entity)

                            ent.Highlight()

                            ids.Add(res.ObjectId)
                            go = True
                        End If
                    End If
                End While

                tr.Commit()
            End Using

            Return ids.ToArray()
        End Function
#End Region