112
« on: May 01, 2012, 07:49:36 AM »
Public Sub DrawRotDimension(ByVal db As Database, ByVal tr As Transaction, ByVal pt1 As Point3d, ByVal pt2 As Point3d, ByVal offset As Double, ByVal dimStyleName As String)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim dtb As DimStyleTable = CType(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If Not dtb.Has(dimStyleName) Then Return
Dim dtr As DimStyleTableRecord = CType(tr.GetObject(dtb(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
Dim ang As Double = AngleFromXAxis(pt1, pt2)
Dim pt3 As Point3d = PolarPoint(pt2, ang + Math.PI / 2, offset)
Dim odim As RotatedDimension = New RotatedDimension(ang, pt1, pt2, pt3, "<>", dtr.ObjectId)
odim.SetDatabaseDefaults()
''change some properties of the dimension if it is needs here
''..........................................
btr.AppendEntity(odim)
tr.AddNewlyCreatedDBObject(odim, True)
' commit transaction or do it in the main program
' tr.Commit()
End Sub
Public Sub DrawAlignDimension(ByVal db As Database, ByVal tr As Transaction, ByVal pt1 As Point3d, ByVal pt2 As Point3d, ByVal pt3 As Point3d, ByVal dimStyleName As String)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim dtb As DimStyleTable = CType(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If Not dtb.Has(dimStyleName) Then Return
Dim dtr As DimStyleTableRecord = CType(tr.GetObject(dtb(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
Dim odim As AlignedDimension = New AlignedDimension(pt1, pt2, pt3, "", dtr.ObjectId)
odim.SetDatabaseDefaults()
''change some properties of the dimension if it is needs here
''..........................................
btr.AppendEntity(odim)
tr.AddNewlyCreatedDBObject(odim, True)
' commit transaction or do it in the main program
' tr.Commit()
End Sub
Public Sub DrawLineAngDimension(ByVal db As Database, ByVal tr As Transaction, ByVal pt1 As Point3d, ByVal pt2 As Point3d, ByVal pt3 As Point3d, ByVal pt4 As Point3d, ByVal pt5 As Point3d, ByVal dimStyleName As String)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim dtb As DimStyleTable = CType(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If Not dtb.Has(dimStyleName) Then Return
Dim dtr As DimStyleTableRecord = CType(tr.GetObject(dtb(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
Dim adim As LineAngularDimension2 = New LineAngularDimension2(pt1, pt2, pt3, pt4, pt5, "", dtr.ObjectId)
adim.SetDatabaseDefaults()
''change some properties of the dimension if it is needs here
''..........................................
btr.AppendEntity(adim)
tr.AddNewlyCreatedDBObject(adim, True)
' commit transaction or do it in the main program
' tr.Commit()
End Sub
Public Sub DrawOrdinateDimension(ByVal db As Database, ByVal tr As Transaction, isAxis As Boolean, ByVal pt1 As Point3d, ByVal pt2 As Point3d, ByVal dimStyleName As String)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim dtb As DimStyleTable = CType(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If Not dtb.Has(dimStyleName) Then Return
Dim dtr As DimStyleTableRecord = CType(tr.GetObject(dtb(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
Dim strdim As String = String.Format("{0:f3}\P{1:f3}", pt1.X, pt1.Y)
Dim adim As OrdinateDimension = New OrdinateDimension(isAxis, pt1, pt2, strdim, dtr.ObjectId)
adim.SetDatabaseDefaults()
''change some properties of the dimension if it is needs here
''..........................................
btr.AppendEntity(adim)
tr.AddNewlyCreatedDBObject(adim, True)
' commit transaction or do it in the main program
' tr.Commit()
End Sub
Public Sub DrawArcDimension(ByVal db As Database, ByVal tr As Transaction, ByVal cpt As Point3d, ByVal pt1 As Point3d, ByVal pt2 As Point3d, ByVal pt3 As Point3d, ByVal dimStyleName As String)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim dtb As DimStyleTable = CType(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If Not dtb.Has(dimStyleName) Then Return
Dim dtr As DimStyleTableRecord = CType(tr.GetObject(dtb(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
Dim adim As ArcDimension = New ArcDimension(cpt, pt1, pt2, pt3, "", dtr.ObjectId)
adim.SetDatabaseDefaults()
''change some properties of the dimension if it is needs here
''..........................................
btr.AppendEntity(adim)
tr.AddNewlyCreatedDBObject(adim, True)
' commit transaction or do it in the main program
' tr.Commit()
End Sub
Public Sub DrawDiametricDimension(ByVal db As Database, ByVal tr As Transaction, ByVal pt1 As Point3d, ByVal pt2 As Point3d, ByVal leg As Double, ByVal dimStyleName As String)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim dtb As DimStyleTable = CType(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If Not dtb.Has(dimStyleName) Then Return
Dim dtr As DimStyleTableRecord = CType(tr.GetObject(dtb(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
Dim odim As DiametricDimension = New DiametricDimension(pt1, pt2, leg, "", dtr.ObjectId)
odim.SetDatabaseDefaults()
''change some properties of the dimension if it is needs here
''..........................................
btr.AppendEntity(odim)
tr.AddNewlyCreatedDBObject(odim, True)
' commit transaction or do it in the main program
' tr.Commit()
End Sub
Public Sub DrawRadialDimension(ByVal db As Database, ByVal tr As Transaction, ByVal cpt As Point3d, ByVal pt1 As Point3d, ByVal leg As Double, ByVal dimStyleName As String)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim dtb As DimStyleTable = CType(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If Not dtb.Has(dimStyleName) Then Return
Dim dtr As DimStyleTableRecord = CType(tr.GetObject(dtb(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
Dim odim As RadialDimension = New RadialDimension(cpt, pt1, leg, "", dtr.ObjectId)
odim.SetDatabaseDefaults()
''change some properties of the dimension if it is needs here
''..........................................
btr.AppendEntity(odim)
tr.AddNewlyCreatedDBObject(odim, True)
' commit transaction or do it in the main program
' tr.Commit()
End Sub
Public Sub DrawRadialDimensionLarge(ByVal db As Database, ByVal tr As Transaction, ByVal cpt As Point3d, ByVal pt1 As Point3d, ByVal pt2 As Point3d, ByVal pt3 As Point3d, ByVal ang As Double, ByVal dimStyleName As String)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim dtb As DimStyleTable = CType(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If Not dtb.Has(dimStyleName) Then Return
Dim dtr As DimStyleTableRecord = CType(tr.GetObject(dtb(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
Dim odim As RadialDimensionLarge = New RadialDimensionLarge(cpt, pt1, pt2, pt3, ang, "", dtr.ObjectId)
odim.SetDatabaseDefaults()
''change some properties of the dimension if it is needs here
''..........................................
btr.AppendEntity(odim)
tr.AddNewlyCreatedDBObject(odim, True)
' commit transaction or do it in the main program
' tr.Commit()
End Sub
Public Sub DrawPoint3AngularDimension(ByVal db As Database, ByVal tr As Transaction, ByVal cpt As Point3d, ByVal pt1 As Point3d, ByVal pt2 As Point3d, ByVal pt3 As Point3d, ByVal dimStyleName As String)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim dtb As DimStyleTable = CType(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If Not dtb.Has(dimStyleName) Then Return
Dim dtr As DimStyleTableRecord = CType(tr.GetObject(dtb(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
Dim odim As Point3AngularDimension = New Point3AngularDimension(cpt, pt1, pt2, pt3, "", dtr.ObjectId)
odim.SetDatabaseDefaults()
''change some properties of the dimension if it is needs here
''..........................................
btr.AppendEntity(odim)
tr.AddNewlyCreatedDBObject(odim, True)
' commit transaction or do it in the main program
' tr.Commit()
End Sub
'' published by Irvin on May 12, 2009 1:25 PM
'' http://forums.autodesk.com/t5/NET/Set-current-textstyle/m-p/2485015/highlight/true#M14423
'' (slightly edited)
<CommandMethod("SetDimStlye")> _
Public Sub SetDimStyle(ByVal dimStyleName As String)
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim DimTbl As DimStyleTable = CType(trans.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
If DimTbl.Has(dimStyleName) Then
Dim DimRecord As DimStyleTableRecord = CType(trans.GetObject(DimTbl(dimStyleName), OpenMode.ForRead), DimStyleTableRecord)
If DimRecord.ObjectId <> db.Dimstyle Then
db.Dimstyle = DimRecord.ObjectId
db.SetDimstyleData(DimRecord)
End If
End If
trans.Commit()
End Using
Dim dimstyleStr As String = Autodesk.AutoCAD.ApplicationServices.Application.GetSystemVariable("dimstyle").ToString()
ed.WriteMessage(vbCr & "Current Dimstyle now: {0}", dimstyleStr)
End Sub
<CommandMethod("GetDimStlye")> _
Public Sub GetCurrDimStyle()
Dim dimstyleStr As String = Autodesk.AutoCAD.ApplicationServices.Application.GetSystemVariable("dimstyle").ToString()
Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("First method: " & dimstyleStr)
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim dt As DimStyleTable = DirectCast(tr.GetObject(db.DimStyleTableId, OpenMode.ForRead), DimStyleTable)
Dim id As ObjectId = db.Dimstyle
Dim dr As DimStyleTableRecord = DirectCast(tr.GetObject(id, OpenMode.ForRead), DimStyleTableRecord)
Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Second method: " & dr.Name)
End Using
End Sub
<CommandMethod("ChangeDimStlye")> _
Public Sub ChangeDimStlye()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim dimTbl As DimStyleTable = tr.GetObject(db.DimStyleTableId, OpenMode.ForRead)
Dim dimDtr As DimStyleTableRecord = tr.GetObject(dimTbl("DimStyle1"), OpenMode.ForRead)
Dim ids As ObjectIdCollection = dimDtr.GetPersistentReactorIds()
For Each objId As ObjectId In ids
If objId.ObjectClass.IsDerivedFrom(RXClass.GetClass(GetType(Dimension))) Then
Dim dimen As Dimension = tr.GetObject(objId, OpenMode.ForWrite)
dimen.DimensionStyle = dimTbl("DimStyle2")
''''' or
''''''dimen.DimensionStyleName = "DimStyle2"
End If
Next
tr.Commit()
End Using
End Sub
Public Shared Function GetPlineCoordinates(ByVal ent As Polyline) As Point3dCollection
Dim pts As Point3dCollection = New Point3dCollection()
Dim coord As Point3d
Dim i As Integer = 0
For i = 0 To ent.NumberOfVertices - 1
coord = ent.GetPoint3dAt(i)
pts.Add(coord)
Next
Return pts
End Function
Public Function Distance(ByVal fPoint As Point3d, ByVal sPoint As Point3d) As Double
Dim x1, x2 As Double
Dim y1, y2 As Double
Dim z1, z2 As Double
Dim cDist As Double
x1 = fPoint.X : y1 = fPoint.Y : z1 = fPoint.Z
x2 = sPoint.X : y2 = sPoint.Y : z2 = sPoint.Z
cDist = Math.Sqrt(((x2 - x1) ^ 2) + ((y2 - y1) ^ 2))
Return cDist
End Function
'' by Tony Tanzillo
Public Function AngleFromXAxis(ByVal p1 As Point3d, ByVal p2 As Point3d) As Double
Return New Vector2d(p2.X - p1.X, p2.Y - p1.Y).Angle
End Function
'' by Tony Tanzillo
Public Function PolarPoint(ByVal basepoint As Point3d, ByVal angle As Double, ByVal distance As Double) As Point3d
Return New Point3d( _
basepoint.X + (distance * Math.Cos(angle)), _
basepoint.Y + (distance * Math.Sin(angle)), _
basepoint.Z)
End Function
Public Shared Function GetFirstPoint(ed As Editor, msg As String, ByRef pt As Point3d) As Boolean
pt = New Point3d()
Dim opt As New PromptPointOptions(vbLf & msg)
Dim res As PromptPointResult = ed.GetPoint(opt)
If res.Status = PromptStatus.OK Then
pt = res.Value
Return True
Else
Return False
End If
End Function
Public Shared Function GetNextPoint(ed As Editor, msg As String, frompt As Point3d, ByRef pt As Point3d) As Boolean
Dim opt As New PromptPointOptions(vbLf & msg)
opt.UseBasePoint = True
opt.AllowNone = True
opt.BasePoint = frompt
Dim res As PromptPointResult = ed.GetPoint(opt)
If res.Status = PromptStatus.OK Then
pt = res.Value
Return True
Else
Return False
End If
End Function
Show Posts