Imports System
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports System.ComponentModel
Imports System.Collections.Specialized
Imports System.Collections.ObjectModel
Imports System.Linq
<Assembly: CommandClass(GetType(tmpdel.MyCommands))>
<Assembly: ExtensionApplication(GetType(tmpdel.MyPlugin))>
Namespace tmpdel
Public Class MyPlugin
Implements IExtensionApplication
Public Sub Initialize() Implements IExtensionApplication.Initialize
End Sub
Public Sub Terminate() Implements IExtensionApplication.Terminate
End Sub
End Class
Public Class MyCommands
<CommandMethod("test")> _
Public Sub test()
Dim oid As ObjectId = pickCurve()
If Not oid.IsNull Then
insertTextToObject.insertNextTo(oid, insertTextToObject.rotate2d.Centroid, 1, "test")
End If
End Sub
Public Function pickCurve() As ObjectId
Dim db As Database = HostApplicationServices.WorkingDatabase()
Dim doc As Document = Application.DocumentManager.GetDocument(db)
Dim ed As Editor = doc.Editor
Dim peo As PromptEntityOptions = New PromptEntityOptions("Select a curve: ")
peo.SetRejectMessage("Selected object is not a curve.")
'peo.AddAllowedClass(GetType(Line), True)
peo.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.Curve), False)
Dim per As PromptEntityResult = ed.GetEntity(peo)
If per.Status = PromptStatus.OK Then
Return per.ObjectId
End If
End Function
End Class
Public Class insertTextToObject
Public Enum rotate2d
No = 0
Aligned = 1
Aligned3D = 2
Centroid = 3
End Enum
Private Class insParameters
Private _point As Point3d
Private _angle As Double
Public Property point As Point3d
Get
Return _point
End Get
Set(value As Point3d)
_point = value
End Set
End Property
Public Property angle As Double
Get
Return _angle
End Get
Set(value As Double)
_angle = value
End Set
End Property
End Class
Public Shared Sub insertNextTo(oid As ObjectId, rotatePolicy As rotate2d, objecttype As Integer, text As String)
Dim db As Database = HostApplicationServices.WorkingDatabase()
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.GetDocument(db)
Dim ed As Editor = doc.Editor
Dim ucs As CoordinateSystem3d = ed.CurrentUserCoordinateSystem.CoordinateSystem3d
Dim normal As Vector3d = ucs.Zaxis
Using l As DocumentLock = doc.LockDocument()
Using trans As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim curentBtrID As ObjectId = db.CurrentSpaceId
Dim btr As BlockTableRecord = trans.GetObject(curentBtrID, OpenMode.ForWrite)
'TODO for each in a list of objects loop may start here
Dim ent As Entity = trans.GetObject(oid, OpenMode.ForRead)
Dim inspars As New insParameters
If objecttype = 1 Then
Dim curve As Curve = DirectCast(ent, Curve)
inspars = getCurveInsPars(rotatePolicy, curve, normal)
End If
'some different type of object
If objecttype = 2 Then
inspars.point = getBoxCenterPoint3d(ent)
End If
'MTEXT is expecting UCS relative angle, but DBTEXT is expecting WCS
insertText(btr, trans, inspars.point, toMostReadable(inspars.angle, ucs, False), text, normal)
insertMText(btr, trans, inspars.point, toMostReadable(inspars.angle, ucs, True), text, normal)
'TODO:insertBlock
'end of for each loop
trans.Commit()
End Using
End Using
Autodesk.AutoCAD.ApplicationServices.Application.UpdateScreen()
End Sub
Public Shared Sub insertText(btr As BlockTableRecord, trans As Transaction, insPoint3d As Point3d, rotation As Double, text As String, normal As Vector3d)
Using acText As DBText = New DBText() 'new object, use using?
acText.Normal = normal
acText.TextString = text
acText.Rotation = rotation
acText.Justify = AttachmentPoint.BottomCenter
acText.AlignmentPoint = insPoint3d
btr.AppendEntity(acText)
trans.AddNewlyCreatedDBObject(acText, True)
End Using
End Sub
Public Shared Sub insertMText(btr As BlockTableRecord, trans As Transaction, insPoint3d As Point3d, rotation As Double, text As String, normal As Vector3d)
Using acText As MText = New MText() 'new object, use using?
'http://stackoverflow.com/questions/20201600/autocad-undefined-shape-style-dialog-crashes
acText.Normal = normal
acText.Contents = text
acText.Rotation = rotation
acText.Attachment = AttachmentPoint.BottomCenter
acText.Location = insPoint3d
btr.AppendEntity(acText)
trans.AddNewlyCreatedDBObject(acText, True)
End Using
End Sub
Private Shared Function getCurveInsPars(rotate As rotate2d, curve As Curve, normal As Vector3d) As insParameters
Dim plineType As RXClass = RXClass.GetClass(GetType(Polyline))
Dim plineType2d As RXClass = RXClass.GetClass(GetType(Polyline2d))
Dim plineType3d As RXClass = RXClass.GetClass(GetType(Polyline3d))
Dim curveType As RXClass = RXClass.GetClass(GetType(Curve))
curveType = curve.GetRXClass
Dim inspars As New insParameters
inspars.point = getCurveMidpoint(curve)
Select Case rotate
Case rotate2d.No
inspars.angle = 0
Case rotate2d.Aligned
If curveType = plineType Or curveType = plineType2d Or curveType = plineType3d Then
'we bet everything is OK and point is on Polyline for sure.
Dim segment As Curve = tryGetOnPolySegment(curve, inspars.point)
If segment IsNot Nothing Then
inspars.point = getCurveMidpoint(segment)
inspars.angle = getAngleToXaxe(segment.StartPoint, segment.EndPoint, normal)
End If
segment.Dispose()
Else
inspars.angle = getAngleToXaxe(curve.StartPoint, curve.EndPoint, normal)
End If
Case rotate2d.Aligned3D
'TODO
inspars.angle = 0
Case rotate2d.Centroid
inspars.angle = 0
inspars.point = getPolyCentroid(curve)
End Select
Return inspars
End Function
Public Shared Function getCurveMidpoint(curve As Curve) As Point3d
If curve.StartPoint = curve.EndPoint Then
Return curve.StartPoint
End If
Dim d1 As Double = curve.GetDistanceAtParameter(curve.StartParam)
Dim d2 As Double = curve.GetDistanceAtParameter(curve.EndParam)
Return curve.GetPointAtDist(d1 + ((d2 - d1) / 2))
End Function
Public Shared Function getRegionCentroid(region As Region) As Point3d
Dim centroidPt As Point3d
Dim solidPlus As New Solid3d()
Dim solidMinus As New Solid3d()
solidPlus.Extrude(region, 1, 0)
solidMinus.Extrude(region, -1, 0)
Dim connectline As New Line(solidPlus.MassProperties.Centroid, solidMinus.MassProperties.Centroid)
centroidPt = connectline.GetPointAtParameter(0.5)
connectline.Dispose()
solidPlus.Dispose()
solidMinus.Dispose()
Return centroidPt
End Function
''' <summary>
''' Return centroid of polyline (if possible for polyline to convert to region).
''' If not (polyline is selfintersecting), return center of the polyline bounding box.
''' </summary>
''' <param name="curve">Polyline from which to create region and.</param>
''' <returns></returns>
''' <remarks></remarks>
Public Shared Function getPolyCentroid(curve As Curve) As Point3d
'it is expected that point is on curve, and curve is type of polyline, or polyline2d, or polyline3d
Dim centroidPt As Point3d
Dim dbobjects As New DBObjectCollection
Dim tmpclosingling As New Line
dbobjects.Add(curve)
'curve.Explode(dbobjects)
If curve.Closed = False Then
'do not change user elements and add temp line to try to create region (otherwise fails if not closed)
'now only selfintersected polylines produce errors
tmpclosingling.StartPoint = curve.StartPoint
tmpclosingling.EndPoint = curve.EndPoint
dbobjects.Add(tmpclosingling)
End If
Try
Dim r As Region = Region.CreateFromCurves(dbobjects)(0)
centroidPt = getRegionCentroid(r)
r.Dispose()
Catch
'polyline is selfintersected
centroidPt = getBoxCenterPoint3d(curve)
End Try
tmpclosingling.Dispose()
dbobjects.Remove(curve)
dbobjects.Dispose()
Return centroidPt
End Function
Public Shared Function getBoxCenterPoint3d(ent As Entity) As Point3d
Dim x As Double = (ent.Bounds.Value.MaxPoint.X + ent.Bounds.Value.MinPoint.X) / 2
Dim y As Double = (ent.Bounds.Value.MaxPoint.Y + ent.Bounds.Value.MinPoint.Y) / 2
Dim z As Double = (ent.Bounds.Value.MaxPoint.Z + ent.Bounds.Value.MinPoint.Z) / 2
Return New Point3d(x, y, z)
End Function
'rotation helpers
''' <summary>
''' Returns angle of vector between two points and X axe on a plain defined with normal.
''' </summary>
''' <param name="startpoint">First point of directional vector</param>
''' <param name="endpoint">Second point of directional vector</param>
''' <param name="normal">Plane normal</param>
''' <returns>Angle to X axe, relative to WCS</returns>
''' <remarks>Some objects use this angle, some UCS relative angle</remarks>
Public Shared Function getAngleToXaxe(startpoint As Point3d, endpoint As Point3d, normal As Vector3d) As Double
Dim vector As Vector3d = startpoint.GetVectorTo(endpoint)
Return getAngleToXaxe(vector, normal)
End Function
''' <summary>
''' Returns angle of vector and X axe on a plain defined with normal.
''' </summary>
''' <param name="vector">Directional vector</param>
''' <param name="normal">Plane normal</param>
''' <returns>Angle to X axe, relative to WCS</returns>
''' <remarks>Some objects use this angle, some UCS relative angle</remarks>
Public Shared Function getAngleToXaxe(vector As Vector3d, normal As Vector3d) As Double
Dim ocsplane = New Plane(Point3d.Origin, normal) 'zaxis
Return vector.AngleOnPlane(ocsplane) 'angle looked from plane normal down
End Function
''' <summary>
''' Returns CCW angle between UCS and WCS X axe,
''' rotation looking from top op zaxis to plane.
''' </summary>
''' <param name="ucs">Any UCS</param>
''' <returns>CCW Angle beteen Wcs and Ucs X axe.</returns>
''' <remarks></remarks>
Public Shared Function getUcsAngleX(ucs As CoordinateSystem3d)
Return ucs.Xaxis.AngleOnPlane(New Plane(Point3d.Origin, ucs.Zaxis)) 'rotation looking from top op zaxis to plane
End Function
''' <summary>
''' Text should be written to be able to be read from the bottom of paper of from the right side of paper.
''' This means mostly text is up or left.
''' </summary>
''' <param name="angleRAD">Angle in WCS</param>
''' <param name="ucs">Any UCS</param>
''' <param name="relativeToUcs">Zero angle is 0 WCS or 0 UCS</param>
''' <returns></returns>
''' <remarks></remarks>
Public Shared Function toMostReadable(angleRAD As Double, ucs As CoordinateSystem3d, relativeToUcs As Boolean) As Double
'will return most readable rotation to text
'for wcs rotation angle, add ucsangle after this process (DBtext), else relative to ucs (Mtext)
Dim ucsAngle As Double = getUcsAngleX(ucs)
angleRAD = angleRAD - ucsAngle
If angleRAD > Math.PI / 2 AndAlso angleRAD <= 3 * Math.PI / 2 Then angleRAD = angleRAD - Math.PI
If relativeToUcs Then
Return angleRAD
Else
Return angleRAD + ucsAngle
End If
End Function
''' <summary>
''' Returns polyline segment over point for any sort of polyline (polyline, poly2d, poly3d).
''' Must
''' </summary>
''' <param name="curve">Any of the three types of polyline, but no other types of curve.</param>
''' <param name="point">Point over segment</param>
''' <returns>New Curve, non DB (ObjectID=Null). Should be disposed or added to DB.</returns>
''' <remarks></remarks>
Public Shared Function tryGetOnPolySegment(curve As Curve, point As Point3d) As Curve
'it is expected that point is for sure somewhere on curve, and curve is type of polyline, or polyline2d, or polyline3d
Dim curveType = RXClass.GetClass(GetType(Curve))
Dim dbobjects As New DBObjectCollection
curve.Explode(dbobjects)
For Each o As DBObject In dbobjects
If o.GetRXClass.IsDerivedFrom(curveType) Then
Dim segment As Curve = DirectCast(o, Curve)
Dim segmentGE As Curve3d = segment.GetGeCurve()
If segmentGE.IsOn(point) Then
dbobjects.Remove(segment)
segmentGE.Dispose()
dbobjects.Dispose()
Return segment
End If
segmentGE.Dispose()
segment.Dispose()
End If
Next
'should never execute, because point is for sure on some segment
dbobjects.Dispose()
Return Nothing
End Function
End Class
End Namespace
