Imports System Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.Geometry Imports Autodesk.AutoCAD.ApplicationServices Imports System.Reflection Imports System.IO Imports System.Collections Imports System.Runtime.InteropServices Imports System.Diagnostics Imports Autodesk.AutoCAD.EditorInput Imports Autodesk.AutoCAD.GraphicsInterface Namespace
TlsCad
Public
Class
BlockRefJig
Inherits EntityJig Private mPosition As Point3d, mAnglePnt As Point3d Private mNormal As Vector3d Private mAngle As Double Private mPromptCounter As Integer Private m_dims As DynamicDimensionDataCollection Public
Sub
New(ByVal vec As Vector3d, ByVal id As ObjectId) MyBase.New(New BlockReference(New Point3d(0, 0, 0), id)) mPosition = New Point3d(0, 0, 0) mNormal = vec mAngle = 0 m_dims = New DynamicDimensionDataCollection() Dim dim1 As Dimension = New AlignedDimension() dim1.SetDatabaseDefaults() m_dims.Add(New DynamicDimensionData(dim1, True, True)) Dim dim2 As Dimension = New AlignedDimension() dim2.SetDatabaseDefaults() m_dims.Add(New DynamicDimensionData(dim2, True, True)) End
Sub
Protected
Overloads
Overrides
Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus Dim jigOpts As
New JigPromptOptions() jigOpts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoZeroResponseAccepted Or UserInputControls.NoNegativeResponseAccepted) If mPromptCounter = 0 Then
jigOpts.Message = "" & Chr(10) & "Input InsertPoint:" Dim dres As PromptPointResult = prompts.AcquirePoint(jigOpts) Dim positionTemp As Point3d = dres.Value If positionTemp <> mPosition Then
mPosition = positionTemp Else
Return SamplerStatus.NoChange End
If
If dres.Status = PromptStatus.Cancel Then
Return SamplerStatus.Cancel Else
Return SamplerStatus.OK End
If
ElseIf mPromptCounter = 1 Then
jigOpts.BasePoint = mPosition jigOpts.UseBasePoint = True
jigOpts.Message = "" & Chr(10) & "Input Angle:" Dim angleTemp As Double = -1 Dim res As PromptPointResult = prompts.AcquirePoint(jigOpts) mAnglePnt = res.Value angleTemp = mAnglePnt.GetVectorTo(mPosition).AngleOnPlane(New Plane(Application.DocumentManager.MdiActiveDocument.Database.Ucsorg, Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir, Application.DocumentManager.MdiActiveDocument.Database.Ucsydir)) If angleTemp <> mAngle Then
mAngle = angleTemp Else
Return SamplerStatus.NoChange End
If
If res.Status = PromptStatus.Cancel Then
Return SamplerStatus.Cancel Else
Return SamplerStatus.OK End
If
Else
Return SamplerStatus.NoChange End
If
End
Function
Protected
Overloads
Overrides
Function Update() As Boolean Try
DirectCast(Entity, BlockReference).Position = mPosition DirectCast(Entity, BlockReference).Rotation = mAngle UpdateDimensions() Catch generatedExceptionName As System.Exception Return
False
End
Try
Return
True
End
Function
Protected
Overloads
Overrides
Function GetDynamicDimensionData(ByVal dimScale As Double) As DynamicDimensionDataCollection Return m_dims End
Function
Protected
Overloads
Overrides
Sub OnDimensionValueChanged(ByVal e As Autodesk.AutoCAD.DatabaseServices.DynamicDimensionChangedEventArgs) End
Sub
Private
Sub UpdateDimensions() Dim blkref As BlockReference = DirectCast(Entity, BlockReference) If mPromptCounter = 0 Then
Dim dim1 As AlignedDimension = DirectCast(m_dims(0).Dimension, AlignedDimension) dim1.XLine1Point = blkref.Position dim1.DimLinePoint = blkref.Position Else
Dim myellipse As Ellipse = DirectCast(Entity, Ellipse) Dim dim2 As AlignedDimension = DirectCast(m_dims(1).Dimension, AlignedDimension) dim2.XLine1Point = blkref.Position dim2.XLine2Point = mAnglePnt dim2.DimLinePoint = blkref.Position End
If
End
Sub
Public
Sub setPromptCounter(ByVal i As Integer) mPromptCounter = i End
Sub
Public
Function GetEntity() As Entity Return Entity End
Function
<CommandMethod("tjig")> _ Public
Shared
Sub DoIt() Dim x As Vector3d = Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir Dim y As Vector3d = Application.DocumentManager.MdiActiveDocument.Database.Ucsydir Dim NormalVec As Vector3d = x.CrossProduct(y) Using tm As
New TlsTM(True) Dim pbt As BlockTable = DirectCast(tm.AutoCadTM.GetObject(tm.Database.BlockTableId, OpenMode.ForRead, True), BlockTable) Dim jig As
New BlockRefJig(NormalVec, pbt("1")) jig.setPromptCounter(0) Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig) jig.setPromptCounter(1) Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig) tm.OpenBlockTableRecord(BlockTableRecord.ModelSpace) tm.Add(jig.GetEntity()) End
Using
End
Sub
End
Class
Public
Class
TlsTM
Implements IDisposable Private db As Database Private tm As AutoCadTM Private ta As Transaction Private bt As BlockTable Private btr As BlockTableRecord Private IsStarted As Boolean = False
Public
Sub
New(ByVal Starting As Boolean) If Starting Then
db = HostApplicationServices.WorkingDatabase tm = db.TransactionManager ta = tm.StartTransaction() End
If
IsStarted = Starting End
Sub
Public
ReadOnly
Property Editor() As Editor Get
Return Application.DocumentManager.MdiActiveDocument.Editor End
Get
End
Property
Public
ReadOnly
Property Database() As Database Get
Return db End
Get
End
Property
Public
ReadOnly
Property AutoCadTM() As AutoCadTM Get
Return tm End
Get
End
Property
Public
ReadOnly
Property Transaction() As Transaction Get
Return ta End
Get
End
Property
Public
ReadOnly
Property BlockTable() As BlockTable Get
Return bt End
Get
End
Property
Public
ReadOnly
Property BlockTableRecord() As BlockTableRecord Get
Return btr End
Get
End
Property
#Region "Add Entity" Public
Function Add(ByVal entity As Entity) As ObjectId Dim id As ObjectId = btr.AppendEntity(entity) tm.AddNewlyCreatedDBObject(entity, True) Return id End
Function
Public
Function Add(ByVal objs As DBObjectCollection) As ObjectIdCollection Dim ids As
New ObjectIdCollection() For
Each obj As DBObject In objs ids.Add(Me.Add(DirectCast(obj, Entity))) Next
Return ids End
Function
Public
Function Add(ByVal objs As DBObject()) As ObjectIdCollection Dim ids As
New ObjectIdCollection() For
Each obj As DBObject In objs ids.Add(Me.Add(DirectCast(obj, Entity))) Next
Return ids End
Function
#End Region #Region "Remove Entity" Public
Function Remove(ByVal id As ObjectId) As Boolean Dim obj As DBObject Try
obj = tm.GetObject(id, OpenMode.ForWrite) obj.(True) Catch
Return
False
End
Try
Return
True
End
Function
Public
Function Remove(ByVal ids As ObjectIdCollection) As Boolean For
Each id As ObjectId In ids Try
Dim obj As DBObject obj = tm.GetObject(id, OpenMode.ForWrite) obj.(True) Catch
Return
False
End
Try
Next
Return
True
End
Function
Public
Function Remove(ByVal ids As ObjectId()) As Boolean For
Each id As ObjectId In ids Try
Dim obj As DBObject obj = tm.GetObject(id, OpenMode.ForWrite) obj.(True) Catch
Return
False
End
Try
Next
Return
True
End
Function
#End Region #Region "Trans" Public
Sub OpenBlockTableRecord(ByVal str As String) bt = DirectCast(tm.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable) btr = DirectCast(tm.GetObject(bt(str), OpenMode.ForWrite, False), BlockTableRecord) End
Sub
Public
Function GetObject(ByVal id As ObjectId, ByVal mode As OpenMode) As Entity Return
DirectCast(tm.GetObject(id, mode, True), Entity) End
Function
Private
Sub Dispose() Implements IDisposable.Dispose If IsStarted Then
ta.Commit() End
If
ta.Dispose() End
Sub
#End Region Public
Sub RegApp(ByVal AppName As String) Dim tbl As RegAppTable = DirectCast(tm.GetObject(db.RegAppTableId, OpenMode.ForWrite, False), RegAppTable) If
Not tbl.Has(AppName) Then
Dim app As
New RegAppTableRecord() app.Name = AppName tbl.Add(app) tm.AddNewlyCreatedDBObject(app, True) End
If
End
Sub
End
Class
End
Namespace
转换成vb.net 05年就写出来了。强呀。
学学，转换成个vb.net express 2010的。在2012下试试。 Public Class BlockRefJig
Inherits EntityJig
Private mPosition As Point3d, mAnglePnt As Point3d
Private mNormal As Vector3d
Private mAngle As Double
Private mPromptCounter As Integer
Private m_dims As DynamicDimensionDataCollection
Public Sub New(ByVal vec As Vector3d, ByVal id As ObjectId)
MyBase.New(New BlockReference(New Point3d(0, 0, 0), id))
mPosition = New Point3d(0, 0, 0)
mNormal = vec
mAngle = 0
m_dims = New DynamicDimensionDataCollection()
Dim dim1 As Dimension = New AlignedDimension()
dim1.SetDatabaseDefaults()
m_dims.Add(New DynamicDimensionData(dim1, True, True))
Dim dim2 As Dimension = New AlignedDimension()
dim2.SetDatabaseDefaults()
m_dims.Add(New DynamicDimensionData(dim2, True, True))
End Sub
Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
'http://bbs.mjtd.com/forum.php?mod=viewthread&tid=39784&extra=page%3D1%26filter%3Dtypeid%26typeid%3D35&page=1
Dim jigOpts As New JigPromptPointOptions()
jigOpts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoZeroResponseAccepted Or UserInputControls.NoNegativeResponseAccepted)
If mPromptCounter = 0 Then
jigOpts.Message = vbLf & "Input InsertPoint:"
Dim dres As PromptPointResult = prompts.AcquirePoint(jigOpts)
Dim positionTemp As Point3d = dres.Value
If positionTemp <> mPosition Then
mPosition = positionTemp
Else
Return SamplerStatus.NoChange
End If
If dres.Status = PromptStatus.Cancel Then
Return SamplerStatus.Cancel
Else
Return SamplerStatus.OK
End If
ElseIf mPromptCounter = 1 Then
jigOpts.BasePoint = mPosition
jigOpts.UseBasePoint = True
jigOpts.Message = vbLf & "Input Angle:"
Dim angleTemp As Double = -1
Dim res As PromptPointResult = prompts.AcquirePoint(jigOpts)
mAnglePnt = res.Value * Math.PI / 180.0
angleTemp = mAnglePnt.GetVectorTo(mPosition).AngleOnPlane(New Plane(Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsorg, Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir, Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsydir))
If angleTemp <> mAngle Then
mAngle = angleTemp
Else
Return SamplerStatus.NoChange
End If
If res.Status = PromptStatus.Cancel Then
Return SamplerStatus.Cancel
Else
Return SamplerStatus.OK
End If
Else
Return SamplerStatus.NoChange
End If
End Function
Protected Overrides Function Update() As Boolean
Try
DirectCast(Entity, BlockReference).Position = mPosition
DirectCast(Entity, BlockReference).Rotation = mAngle
UpdateDimensions()
Catch generatedExceptionName As System.Exception
Return False
End Try
Return True
End Function
Protected Overrides Function GetDynamicDimensionData(ByVal dimScale As Double) As DynamicDimensionDataCollection
Return m_dims
End Function
Protected Overrides Sub OnDimensionValueChanged(ByVal e As Autodesk.AutoCAD.DatabaseServices.DynamicDimensionChangedEventArgs)
End Sub
Private Sub UpdateDimensions()
Dim blkref As BlockReference = DirectCast(Entity, BlockReference)
If mPromptCounter = 0 Then
Dim dim1 As AlignedDimension = DirectCast(m_dims(0).Dimension, AlignedDimension)
dim1.XLine1Point = blkref.Position
dim1.DimLinePoint = blkref.Position
Else
Dim myellipse As Ellipse = DirectCast(Entity, Ellipse)
Dim dim2 As AlignedDimension = DirectCast(m_dims(1).Dimension, AlignedDimension)
dim2.XLine1Point = blkref.Position
dim2.XLine2Point = mAnglePnt
dim2.DimLinePoint = blkref.Position
End If
End Sub
Public Sub setPromptCounter(ByVal i As Integer)
mPromptCounter = i
End Sub
Public Function GetEntity() As Entity
Return Entity
End Function
<CommandMethod("tjig")> _
Public Shared Sub tjigDoIt()
Dim x As Vector3d = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir
Dim y As Vector3d = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsydir
Dim NormalVec As Vector3d = x.CrossProduct(y)
Using tm As New TlsTM(True)
Dim pbt As BlockTable = DirectCast(tm.AutoCadTM.GetObject(tm.Database.BlockTableId, OpenMode.ForRead, True), BlockTable)
Dim jig As New BlockRefJig(NormalVec, pbt("1"))
jig.setPromptCounter(0)
Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)
jig.setPromptCounter(1)
Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)
tm.OpenBlockTableRecord(BlockTableRecord.ModelSpace)
tm.Add(jig.GetEntity())
End Using
End Sub
End Class
Public Class TlsTM
Implements IDisposable
Private db As Database
Private tm As DatabaseServices.TransactionManager
Private ta As Transaction
Private bt As BlockTable
Private btr As BlockTableRecord
Private IsStarted As Boolean = False
Public Sub New(ByVal Starting As Boolean)
If Starting Then
Dim oDWG As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
' Get the database in the active drawing
db = oDWG.Database
' Open a transaction so we can modify the drawing
tm = db.TransactionManager
'db = HostApplicationServices.WorkingDatabase
'tm = db.TransactionManager
ta = tm.StartTransaction()
End If
IsStarted = Starting
End Sub
Public ReadOnly Property Editor() As Editor
Get
Return Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
End Get
End Property
Public ReadOnly Property Database() As Database
Get
Return db
End Get
End Property
Public ReadOnly Property AutoCadTM() As DatabaseServices.TransactionManager
Get
Return tm
End Get
End Property
Public ReadOnly Property Transaction() As Transaction
Get
Return ta
End Get
End Property
Public ReadOnly Property BlockTable() As BlockTable
Get
Return bt
End Get
End Property
Public ReadOnly Property BlockTableRecord() As BlockTableRecord
Get
Return btr
End Get
End Property
#Region "Add Entity"
Public Function Add(ByVal entity As Entity) As ObjectId
Dim id As ObjectId = btr.AppendEntity(entity)
tm.AddNewlyCreatedDBObject(entity, True)
Return id
End Function
Public Function Add(ByVal objs As DBObjectCollection) As ObjectIdCollection
Dim ids As New ObjectIdCollection()
For Each obj As DBObject In objs
ids.Add(Me.Add(DirectCast(obj, Entity)))
Next
Return ids
End Function
Public Function Add(ByVal objs As DBObject()) As ObjectIdCollection
Dim ids As New ObjectIdCollection()
For Each obj As DBObject In objs
ids.Add(Me.Add(DirectCast(obj, Entity)))
Next
Return ids
End Function
#End Region
#Region "Remove Entity"
Public Function Remove(ByVal id As ObjectId) As Boolean
Dim obj As DBObject
Try
obj = tm.GetObject(id, OpenMode.ForWrite)
obj.(True)
Catch
Return False
End Try
Return True
End Function
Public Function Remove(ByVal ids As ObjectIdCollection) As Boolean
For Each id As ObjectId In ids
Try
Dim obj As DBObject
obj = tm.GetObject(id, OpenMode.ForWrite)
obj.(True)
Catch
Return False
End Try
Next
Return True
End Function
Public Function Remove(ByVal ids As ObjectId()) As Boolean
For Each id As ObjectId In ids
Try
Dim obj As DBObject
obj = tm.GetObject(id, OpenMode.ForWrite)
obj.(True)
Catch
Return False
End Try
Next
Return True
End Function
#End Region
#Region "Trans"
Public Sub OpenBlockTableRecord(ByVal str As String)
bt = DirectCast(tm.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)
btr = DirectCast(tm.GetObject(bt(str), OpenMode.ForWrite, False), BlockTableRecord)
End Sub
Public Function GetObject(ByVal id As ObjectId, ByVal mode As OpenMode) As Entity
Return DirectCast(tm.GetObject(id, mode, True), Entity)
End Function
Private Sub IDisposable_Dispose() Implements IDisposable.Dispose
If IsStarted Then
ta.Commit()
End If
ta.Dispose()
End Sub
#End Region
Public Sub RegApp(ByVal AppName As String)
Dim tbl As RegAppTable = DirectCast(tm.GetObject(db.RegAppTableId, OpenMode.ForWrite, False), RegAppTable)
If Not tbl.Has(AppName) Then
Dim app As New RegAppTableRecord()
app.Name = AppName
tbl.Add(app)
tm.AddNewlyCreatedDBObject(app, True)
End If
End Sub
End Class
页:
1
[2]