After looking for so many codes and suggestions, I decided tu debug my own code and build a Jig for MLeader with mirroring block object. Down below is my code running perfectly in VS19 x Intellicad 9.
Imports App = IntelliCAD.ApplicationServices.Application
Module JigLeader
Public Sub CreateLeader()
'' Get the current database
Dim acDoc As Document = App.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
'' Start a transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'' Open the Block table for read
Dim acBlkTbl As BlockTable
acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead)
'' Open the Block table record Model space for write
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), Teigha.DatabaseServices.OpenMode.ForWrite)
'' Create the leader
Using acLdr As Leader = New Leader()
acLdr.AppendVertex(New Point3d(0, 0, 0))
acLdr.AppendVertex(New Point3d(4, 4, 0))
acLdr.AppendVertex(New Point3d(4, 5, 0))
acLdr.HasArrowHead = True
'' Add the new object to Model space and the transaction
acBlkTblRec.AppendEntity(acLdr)
acTrans.AddNewlyCreatedDBObject(acLdr, True)
End Using
'' Commit the changes and dispose of the transaction
acTrans.Commit()
End Using
End Sub
End Module
Namespace LeaderPlacement
Public Class MLeaderJig
Inherits EntityJig
Protected _start As Point3d, _end As Point3d
Private _index As Integer
Private _lineIndex As Integer
Protected _started As Boolean
Private _blkName As String
Private m_pts As Point3dCollection
'Private m_leaderIndex As Integer
'Private m_LeaderLineIndex As Integer
Private m_tempPoint As Point3d
Public Sub New(BlockContent As String, Start As Point3d)
MyBase.New(New MLeader())
m_pts = New Point3dCollection()
Dim ml As MLeader = GetEntity()
ml.SetDatabaseDefaults()
ml.ContentType = ContentType.BlockContent
ml.EnableDogleg = True
ml.EnableLanding = True
ml.LandingGap = 0
'_index = ml.AddLeader()
_lineIndex = -1
_started = False
_blkName = BlockContent
_start = Start
_end = Start
_index = ml.AddLeader()
AddVertex()
End Sub
' A fairly standard Sampler function
Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
Dim opts As JigPromptPointOptions = New JigPromptPointOptions()
opts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoNegativeResponseAccepted)
If m_pts.Count = 0 Then
opts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoNegativeResponseAccepted)
opts.Message = vbLf & "Start point of multileader: "
opts.UseBasePoint = False
ElseIf m_pts.Count = 1 Then
opts.BasePoint = m_pts(m_pts.Count - 1)
opts.UseBasePoint = True
opts.Message = vbLf & "Specify multileader vertex: "
ElseIf m_pts.Count > 1 Then
'opts.UserInputControls = opts.UserInputControls Or UserInputControls.NullResponseAccepted 'UserInputControls.Accept3dCoordinates Or UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect Or UserInputControls.UseBasePointElevation
opts.UserInputControls = (UserInputControls.AnyBlankTerminatesInput Or UserInputControls.NoNegativeResponseAccepted Or
UserInputControls.Accept3dCoordinates Or UserInputControls.AcceptMouseUpAsPoint Or UserInputControls.NullResponseAccepted Or UserInputControls.AcceptOtherInputString Or
UserInputControls.GovernedByUCSDetect Or UserInputControls.GovernedByOrthoMode Or UserInputControls.InitialBlankTerminatesInput Or UserInputControls.NoZeroResponseAccepted)
opts.BasePoint = m_pts(m_pts.Count - 1)
opts.UseBasePoint = True
opts.SetMessageAndKeywords(vbLf & "Specify multileader vertex or : [End]", "End")
'opts.Message = vbLf & "Specify multileader vertex: "
Else
Return SamplerStatus.Cancel
End If
Dim res As PromptPointResult = prompts.AcquirePoint(opts)
If _end = res.Value Then
Return SamplerStatus.NoChange
ElseIf res.Status = PromptStatus.OK Then
_end = res.Value
Return SamplerStatus.OK
End If
Return SamplerStatus.Cancel
End Function
Protected Overrides Function Update() As Boolean
Dim ml = DirectCast(Entity, MLeader)
If m_pts.Count > 0 Then
ml.SetLastVertex(_lineIndex, _end)
Dim _dl = New Vector3d(If(_end.X <= m_pts(m_pts.Count - 1).X, -1, 1), 0, 0)
Dim doglen As Double = ml.DoglegLength * IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Cannoscale.DrawingUnits
Dim landgap As Double = ml.LandingGap
If _end.X <= m_pts(m_pts.Count - 1).X Then
ml.EnableDogleg = True
ml.SetDogleg(_lineIndex, _dl)
ml.BlockPosition = _end + ((doglen + landgap) * _dl)
Else
ml.EnableDogleg = False
ml.BlockPosition = _end
End If
End If
If Not _started Then
If _start.DistanceTo(_end) > Tolerance.[Global].EqualPoint Then
Dim doc As Document = App.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
ml.ContentType = ContentType.BlockContent
Dim ocm = db.ObjectContextManager
Dim occ = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
ml.AddContext(occ.CurrentContext)
Using Tx As Transaction = db.TransactionManager.StartTransaction
Dim table As BlockTable = Tx.GetObject(db.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead)
Dim model As BlockTableRecord = Tx.GetObject(table(BlockTableRecord.ModelSpace), Teigha.DatabaseServices.OpenMode.ForWrite)
If Not table.Has(_blkName) Then
ed.WriteMessage(String.Format("\nPrecisa definir o bloco {0}", _blkName))
Return False
End If
ml.BlockContentId = table(_blkName)
'ml.BlockPosition = New Point3d(4, 2, 0)
Dim AttNumber As Integer = 0
Dim blkLeader As BlockTableRecord = TryCast(Tx.GetObject(ml.BlockContentId, Teigha.DatabaseServices.OpenMode.ForRead), BlockTableRecord)
Dim Transfo As Matrix3d = Matrix3d.Displacement(ml.BlockPosition.GetAsVector())
For Each blkEntId As ObjectId In blkLeader
Dim AttributeDef As AttributeDefinition = TryCast(Tx.GetObject(blkEntId, Teigha.DatabaseServices.OpenMode.ForRead), AttributeDefinition)
If AttributeDef IsNot Nothing Then
Dim AttributeRef As New AttributeReference()
AttributeRef.SetAttributeFromBlock(AttributeDef, Transfo)
AttributeRef.Position = AttributeDef.Position.TransformBy(Transfo)
Commit(AttributeRef)
ml.SetBlockAttribute(blkEntId, AttributeRef)
End If
Next
Tx.Commit()
End Using
'AddVertex()
_started = True
End If
Else
ml.Visible = True
'ml.SetLastVertex(_lineIndex, _end)
End If
Return True
End Function
Public Sub AddVertex()
Dim ml As MLeader = TryCast(Entity, MLeader)
If m_pts.Count = 0 Then
_lineIndex = ml.AddLeaderLine(_index)
ml.AddFirstVertex(_lineIndex, _start)
'ml.AddLastVertex(_lineIndex, _end)
Else
ml.AddLastVertex(_lineIndex, _end)
End If
m_pts.Add(_end)
End Sub
Public Sub RemoveLastVertex()
Dim ml As MLeader = TryCast(Entity, MLeader)
Dim dogvec As Vector3d = ml.GetDogleg(_index)
Dim doglen As Double = ml.DoglegLength * IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Cannoscale.DrawingUnits
Dim landgap As Double = ml.LandingGap
'If m_pts.Count >= 1 Then
If ml.GetLastVertex(_lineIndex).X <= ml.GetVertex(_lineIndex, ml.VerticesCount(_lineIndex) - 2).X Then
dogvec = New Vector3d(-1, 0, 0)
ml.BlockPosition = ml.GetLastVertex(_lineIndex) + ((doglen + landgap) * dogvec)
Else
dogvec = New Vector3d(1, 0, 0)
End If
'End If
End Sub
Public Function GetEntity() As Teigha.DatabaseServices.MLeader
Return TryCast(MyBase.Entity, Teigha.DatabaseServices.MLeader)
End Function
Public Overridable Sub Commit(AttributeRef As AttributeReference)
' nada aqui
'Select Case AttributeRef.Tag
' Case "MARCA"
' AttributeRef.TextString = _contents.Marca
' Case "QTD"
' AttributeRef.TextString = _contents.Qtde
' Case "TRATAMENTO"
' AttributeRef.TextString = _contents.Tratamento
' Case "DESCRICAO"
' AttributeRef.TextString = _contents.descricao
' Case "LISTA"
' AttributeRef.TextString = _contents.lista
'End Select
End Sub
Public Sub MyMLeaderJig()
Dim doc As Document = IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
'Dim jig As MLeaderJig = New MLeaderJig("novo_ponto", CType(blockContent.Entity, DBPoint).Position)
Dim bSuccess As Boolean = True, bComplete As Boolean = False
While bSuccess AndAlso Not bComplete
Dim dragres As PromptResult = ed.Drag(Me)
bSuccess = (dragres.Status = PromptStatus.OK)
If bSuccess Then Me.AddVertex()
bComplete = (dragres.Status = PromptStatus.None)
If bComplete Then Me.RemoveLastVertex()
End While
If bComplete Then
Dim tr As Transaction = db.TransactionManager.StartTransaction()
Using tr
Dim bt As BlockTable = CType(tr.GetObject(db.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead, False), BlockTable)
Dim btr As BlockTableRecord = CType(tr.GetObject(bt(BlockTableRecord.ModelSpace), Teigha.DatabaseServices.OpenMode.ForWrite, False), BlockTableRecord)
btr.AppendEntity(Me.GetEntity())
tr.AddNewlyCreatedDBObject(Me.GetEntity(), True)
tr.Commit()
End Using
End If
End Sub
End Class
Public Class Leader
Inherits MLeaderJig
Protected blockContent As XPV
Public Sub New(PV As XPV)
MyBase.New("novo_ponto", CType(PV.Entity, DBPoint).Position)
blockContent = PV
' Store info that's passed in, but don't init the MLeader
End Sub
Public Overrides Sub Commit(AttributeRef As AttributeReference)
Select Case AttributeRef.Tag
Case Is = "PV"
AttributeRef.TextString = blockContent.PV
Case Is = "CT"
AttributeRef.TextString = blockContent.CT
Case Is = "CF"
AttributeRef.TextString = blockContent.CF
Case Is = "CTERRENO"
AttributeRef.TextString = blockContent.CTerreno
Case Is = "PON"
AttributeRef.TextString = blockContent.TAG
End Select
End Sub
End Class
End Namespace
Re: Using of Ji MLeader
#2After L.MyMLeaderJig() the line L.ObjetId gets eNotOpenForRead.
Any idea how access objects/elements from inside classes after they had been created and added to BlockTableRecord via Transaction ?
Public Sub Cmd2()
' If ps Is Nothing Then
Try
While True
Using tx As Transaction = App.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction
Dim pso As New PromptSelectionOptions
pso.MessageForAdding = "Selecione>"
Dim psr As PromptSelectionResult = IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.GetSelection(pso)
If Not psr.Status = PromptStatus.OK Then Exit While
Dim PV As New XPV '(psr.Value(0).ObjectId)
PV.Entity = tx.GetObject(psr.Value(0).ObjectId, Teigha.DatabaseServices.OpenMode.ForRead)
PV.Retrieve()
Dim L As New Leader(PV)
L.MyMLeaderJig()
Dim id As ObjectId = L.ObjetId
Dim Xpvl As New XPVLeader
Xpvl.Entity = L.MLeaderEntity.ObjectId.GetObject(Teigha.DatabaseServices.OpenMode.ForRead)
Xpvl.EntityToHandle = PV.Entity.Handle
Xpvl.Commit()
tx.Commit()
End Using
End While
Catch ex As System.Exception
IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(ex.ToString)
End Try
End Sub
Any idea how access objects/elements from inside classes after they had been created and added to BlockTableRecord via Transaction ?
Public Sub Cmd2()
' If ps Is Nothing Then
Try
While True
Using tx As Transaction = App.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction
Dim pso As New PromptSelectionOptions
pso.MessageForAdding = "Selecione>"
Dim psr As PromptSelectionResult = IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.GetSelection(pso)
If Not psr.Status = PromptStatus.OK Then Exit While
Dim PV As New XPV '(psr.Value(0).ObjectId)
PV.Entity = tx.GetObject(psr.Value(0).ObjectId, Teigha.DatabaseServices.OpenMode.ForRead)
PV.Retrieve()
Dim L As New Leader(PV)
L.MyMLeaderJig()
Dim id As ObjectId = L.ObjetId
Dim Xpvl As New XPVLeader
Xpvl.Entity = L.MLeaderEntity.ObjectId.GetObject(Teigha.DatabaseServices.OpenMode.ForRead)
Xpvl.EntityToHandle = PV.Entity.Handle
Xpvl.Commit()
tx.Commit()
End Using
End While
Catch ex As System.Exception
IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(ex.ToString)
End Try
End Sub
DenisSilveira wrote: ↑Fri May 29, 2020 8:33 amAfter looking for so many codes and suggestions, I decided tu debug my own code and build a Jig for MLeader with mirroring block object. Down below is my code running perfectly in VS19 x Intellicad 9.
Imports App = IntelliCAD.ApplicationServices.Application
Module JigLeader
Public Sub CreateLeader()
'' Get the current database
Dim acDoc As Document = App.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
'' Start a transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'' Open the Block table for read
Dim acBlkTbl As BlockTable
acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead)
'' Open the Block table record Model space for write
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), Teigha.DatabaseServices.OpenMode.ForWrite)
'' Create the leader
Using acLdr As Leader = New Leader()
acLdr.AppendVertex(New Point3d(0, 0, 0))
acLdr.AppendVertex(New Point3d(4, 4, 0))
acLdr.AppendVertex(New Point3d(4, 5, 0))
acLdr.HasArrowHead = True
'' Add the new object to Model space and the transaction
acBlkTblRec.AppendEntity(acLdr)
acTrans.AddNewlyCreatedDBObject(acLdr, True)
End Using
'' Commit the changes and dispose of the transaction
acTrans.Commit()
End Using
End Sub
End Module
Namespace LeaderPlacement
Public Class MLeaderJig
Inherits EntityJig
Protected _start As Point3d, _end As Point3d
Private _index As Integer
Private _lineIndex As Integer
Protected _started As Boolean
Private _blkName As String
Private m_pts As Point3dCollection
'Private m_leaderIndex As Integer
'Private m_LeaderLineIndex As Integer
Private m_tempPoint As Point3d
Public Sub New(BlockContent As String, Start As Point3d)
MyBase.New(New MLeader())
m_pts = New Point3dCollection()
Dim ml As MLeader = GetEntity()
ml.SetDatabaseDefaults()
ml.ContentType = ContentType.BlockContent
ml.EnableDogleg = True
ml.EnableLanding = True
ml.LandingGap = 0
'_index = ml.AddLeader()
_lineIndex = -1
_started = False
_blkName = BlockContent
_start = Start
_end = Start
_index = ml.AddLeader()
AddVertex()
End Sub
' A fairly standard Sampler function
Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
Dim opts As JigPromptPointOptions = New JigPromptPointOptions()
opts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoNegativeResponseAccepted)
If m_pts.Count = 0 Then
opts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoNegativeResponseAccepted)
opts.Message = vbLf & "Start point of multileader: "
opts.UseBasePoint = False
ElseIf m_pts.Count = 1 Then
opts.BasePoint = m_pts(m_pts.Count - 1)
opts.UseBasePoint = True
opts.Message = vbLf & "Specify multileader vertex: "
ElseIf m_pts.Count > 1 Then
'opts.UserInputControls = opts.UserInputControls Or UserInputControls.NullResponseAccepted 'UserInputControls.Accept3dCoordinates Or UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect Or UserInputControls.UseBasePointElevation
opts.UserInputControls = (UserInputControls.AnyBlankTerminatesInput Or UserInputControls.NoNegativeResponseAccepted Or
UserInputControls.Accept3dCoordinates Or UserInputControls.AcceptMouseUpAsPoint Or UserInputControls.NullResponseAccepted Or UserInputControls.AcceptOtherInputString Or
UserInputControls.GovernedByUCSDetect Or UserInputControls.GovernedByOrthoMode Or UserInputControls.InitialBlankTerminatesInput Or UserInputControls.NoZeroResponseAccepted)
opts.BasePoint = m_pts(m_pts.Count - 1)
opts.UseBasePoint = True
opts.SetMessageAndKeywords(vbLf & "Specify multileader vertex or : [End]", "End")
'opts.Message = vbLf & "Specify multileader vertex: "
Else
Return SamplerStatus.Cancel
End If
Dim res As PromptPointResult = prompts.AcquirePoint(opts)
If _end = res.Value Then
Return SamplerStatus.NoChange
ElseIf res.Status = PromptStatus.OK Then
_end = res.Value
Return SamplerStatus.OK
End If
Return SamplerStatus.Cancel
End Function
Protected Overrides Function Update() As Boolean
Dim ml = DirectCast(Entity, MLeader)
If m_pts.Count > 0 Then
ml.SetLastVertex(_lineIndex, _end)
Dim _dl = New Vector3d(If(_end.X <= m_pts(m_pts.Count - 1).X, -1, 1), 0, 0)
Dim doglen As Double = ml.DoglegLength * IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Cannoscale.DrawingUnits
Dim landgap As Double = ml.LandingGap
If _end.X <= m_pts(m_pts.Count - 1).X Then
ml.EnableDogleg = True
ml.SetDogleg(_lineIndex, _dl)
ml.BlockPosition = _end + ((doglen + landgap) * _dl)
Else
ml.EnableDogleg = False
ml.BlockPosition = _end
End If
End If
If Not _started Then
If _start.DistanceTo(_end) > Tolerance.[Global].EqualPoint Then
Dim doc As Document = App.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
ml.ContentType = ContentType.BlockContent
Dim ocm = db.ObjectContextManager
Dim occ = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
ml.AddContext(occ.CurrentContext)
Using Tx As Transaction = db.TransactionManager.StartTransaction
Dim table As BlockTable = Tx.GetObject(db.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead)
Dim model As BlockTableRecord = Tx.GetObject(table(BlockTableRecord.ModelSpace), Teigha.DatabaseServices.OpenMode.ForWrite)
If Not table.Has(_blkName) Then
ed.WriteMessage(String.Format("\nPrecisa definir o bloco {0}", _blkName))
Return False
End If
ml.BlockContentId = table(_blkName)
'ml.BlockPosition = New Point3d(4, 2, 0)
Dim AttNumber As Integer = 0
Dim blkLeader As BlockTableRecord = TryCast(Tx.GetObject(ml.BlockContentId, Teigha.DatabaseServices.OpenMode.ForRead), BlockTableRecord)
Dim Transfo As Matrix3d = Matrix3d.Displacement(ml.BlockPosition.GetAsVector())
For Each blkEntId As ObjectId In blkLeader
Dim AttributeDef As AttributeDefinition = TryCast(Tx.GetObject(blkEntId, Teigha.DatabaseServices.OpenMode.ForRead), AttributeDefinition)
If AttributeDef IsNot Nothing Then
Dim AttributeRef As New AttributeReference()
AttributeRef.SetAttributeFromBlock(AttributeDef, Transfo)
AttributeRef.Position = AttributeDef.Position.TransformBy(Transfo)
Commit(AttributeRef)
ml.SetBlockAttribute(blkEntId, AttributeRef)
End If
Next
Tx.Commit()
End Using
'AddVertex()
_started = True
End If
Else
ml.Visible = True
'ml.SetLastVertex(_lineIndex, _end)
End If
Return True
End Function
Public Sub AddVertex()
Dim ml As MLeader = TryCast(Entity, MLeader)
If m_pts.Count = 0 Then
_lineIndex = ml.AddLeaderLine(_index)
ml.AddFirstVertex(_lineIndex, _start)
'ml.AddLastVertex(_lineIndex, _end)
Else
ml.AddLastVertex(_lineIndex, _end)
End If
m_pts.Add(_end)
End Sub
Public Sub RemoveLastVertex()
Dim ml As MLeader = TryCast(Entity, MLeader)
Dim dogvec As Vector3d = ml.GetDogleg(_index)
Dim doglen As Double = ml.DoglegLength * IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Cannoscale.DrawingUnits
Dim landgap As Double = ml.LandingGap
'If m_pts.Count >= 1 Then
If ml.GetLastVertex(_lineIndex).X <= ml.GetVertex(_lineIndex, ml.VerticesCount(_lineIndex) - 2).X Then
dogvec = New Vector3d(-1, 0, 0)
ml.BlockPosition = ml.GetLastVertex(_lineIndex) + ((doglen + landgap) * dogvec)
Else
dogvec = New Vector3d(1, 0, 0)
End If
'End If
End Sub
Public Function GetEntity() As Teigha.DatabaseServices.MLeader
Return TryCast(MyBase.Entity, Teigha.DatabaseServices.MLeader)
End Function
Public Overridable Sub Commit(AttributeRef As AttributeReference)
' nada aqui
'Select Case AttributeRef.Tag
' Case "MARCA"
' AttributeRef.TextString = _contents.Marca
' Case "QTD"
' AttributeRef.TextString = _contents.Qtde
' Case "TRATAMENTO"
' AttributeRef.TextString = _contents.Tratamento
' Case "DESCRICAO"
' AttributeRef.TextString = _contents.descricao
' Case "LISTA"
' AttributeRef.TextString = _contents.lista
'End Select
End Sub
Public Sub MyMLeaderJig()
Dim doc As Document = IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
'Dim jig As MLeaderJig = New MLeaderJig("novo_ponto", CType(blockContent.Entity, DBPoint).Position)
Dim bSuccess As Boolean = True, bComplete As Boolean = False
While bSuccess AndAlso Not bComplete
Dim dragres As PromptResult = ed.Drag(Me)
bSuccess = (dragres.Status = PromptStatus.OK)
If bSuccess Then Me.AddVertex()
bComplete = (dragres.Status = PromptStatus.None)
If bComplete Then Me.RemoveLastVertex()
End While
If bComplete Then
Dim tr As Transaction = db.TransactionManager.StartTransaction()
Using tr
Dim bt As BlockTable = CType(tr.GetObject(db.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead, False), BlockTable)
Dim btr As BlockTableRecord = CType(tr.GetObject(bt(BlockTableRecord.ModelSpace), Teigha.DatabaseServices.OpenMode.ForWrite, False), BlockTableRecord)
btr.AppendEntity(Me.GetEntity())
tr.AddNewlyCreatedDBObject(Me.GetEntity(), True)
tr.Commit()
End Using
End If
End Sub
End Class
Public Class Leader
Inherits MLeaderJig
Protected blockContent As XPV
Public Sub New(PV As XPV)
MyBase.New("novo_ponto", CType(PV.Entity, DBPoint).Position)
blockContent = PV
' Store info that's passed in, but don't init the MLeader
End Sub
Public Overrides Sub Commit(AttributeRef As AttributeReference)
Select Case AttributeRef.Tag
Case Is = "PV"
AttributeRef.TextString = blockContent.PV
Case Is = "CT"
AttributeRef.TextString = blockContent.CT
Case Is = "CF"
AttributeRef.TextString = blockContent.CF
Case Is = "CTERRENO"
AttributeRef.TextString = blockContent.CTerreno
Case Is = "PON"
AttributeRef.TextString = blockContent.TAG
End Select
End Sub
End Class
End Namespace
Re: Using of Ji MLeader
#3After L.MyMLeaderJig() the line L.ObjetId gets eNotOpenForRead.
Please try use "UpgradeOpen" to open the object for Write.
L.UpgradeOpen()
L.MyMLeaderJig()
Please try use "UpgradeOpen" to open the object for Write.
L.UpgradeOpen()
L.MyMLeaderJig()
Re: Using of Ji MLeader
#4The "L" is a class implemented by myself inherits Jig and doesn't have UpGradeOpen.
May I send file to you.
May I send file to you.
Code: Select all
Imports IntelliCAD.ApplicationServices
Imports IntelliCAD.EditorInput
Imports Teigha.DatabaseServices
Imports Teigha.Geometry
Imports App = IntelliCAD.ApplicationServices.Application
Namespace LeaderPlacement
Public Class MLeaderJig
Inherits EntityJig
Protected _start As Point3d, _end As Point3d
Private _index As Integer
Private _lineIndex As Integer
Protected _started As Boolean
Private _blkName As String
Private m_pts As Point3dCollection
'Private m_leaderIndex As Integer
'Private m_LeaderLineIndex As Integer
Private m_tempPoint As Point3d
Public Sub New(BlockContent As String, Start As Point3d)
MyBase.New(New MLeader())
m_pts = New Point3dCollection()
Dim ml As MLeader = GetEntity()
ml.SetDatabaseDefaults()
ml.ContentType = ContentType.BlockContent
ml.EnableDogleg = True
ml.EnableLanding = True
ml.LandingGap = 0
'_index = ml.AddLeader()
_lineIndex = -1
_started = False
_blkName = BlockContent
_start = Start
_end = Start
_index = ml.AddLeader()
AddVertex()
End Sub
' A fairly standard Sampler function
Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
Dim opts As JigPromptPointOptions = New JigPromptPointOptions()
opts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoNegativeResponseAccepted)
If m_pts.Count = 0 Then
opts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoNegativeResponseAccepted)
opts.Message = vbLf & "Start point of multileader: "
opts.UseBasePoint = False
ElseIf m_pts.Count = 1 Then
opts.BasePoint = m_pts(m_pts.Count - 1)
opts.UseBasePoint = True
opts.Message = vbLf & "Specify multileader vertex: "
ElseIf m_pts.Count > 1 Then
'opts.UserInputControls = opts.UserInputControls Or UserInputControls.NullResponseAccepted 'UserInputControls.Accept3dCoordinates Or UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect Or UserInputControls.UseBasePointElevation
opts.UserInputControls = (UserInputControls.AnyBlankTerminatesInput Or UserInputControls.NoNegativeResponseAccepted Or
UserInputControls.Accept3dCoordinates Or UserInputControls.AcceptMouseUpAsPoint Or UserInputControls.NullResponseAccepted Or UserInputControls.AcceptOtherInputString Or
UserInputControls.GovernedByUCSDetect Or UserInputControls.GovernedByOrthoMode Or UserInputControls.InitialBlankTerminatesInput Or UserInputControls.NoZeroResponseAccepted)
opts.BasePoint = m_pts(m_pts.Count - 1)
opts.UseBasePoint = True
opts.SetMessageAndKeywords(vbLf & "Specify multileader vertex or : [End]", "End")
'opts.Message = vbLf & "Specify multileader vertex: "
Else
Return SamplerStatus.Cancel
End If
Dim res As PromptPointResult = prompts.AcquirePoint(opts)
If _end = res.Value Then
Return SamplerStatus.NoChange
ElseIf res.Status = PromptStatus.OK Then
_end = res.Value
Return SamplerStatus.OK
End If
Return SamplerStatus.Cancel
End Function
Protected Overrides Function Update() As Boolean
Dim ml = DirectCast(Entity, MLeader)
If m_pts.Count > 0 Then
ml.SetLastVertex(_lineIndex, _end)
Dim _dl = New Vector3d(If(_end.X <= m_pts(m_pts.Count - 1).X, -1, 1), 0, 0)
Dim doglen As Double = ml.DoglegLength * IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Cannoscale.DrawingUnits
Dim landgap As Double = ml.LandingGap
If _end.X <= m_pts(m_pts.Count - 1).X Then
ml.EnableDogleg = True
ml.SetDogleg(_lineIndex, _dl)
ml.BlockPosition = _end + ((doglen + landgap) * _dl)
Else
ml.EnableDogleg = False
ml.BlockPosition = _end
End If
End If
If Not _started Then
If _start.DistanceTo(_end) > Tolerance.[Global].EqualPoint Then
Dim doc As Document = App.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
ml.ContentType = ContentType.BlockContent
Dim ocm = db.ObjectContextManager
Dim occ = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
ml.AddContext(occ.CurrentContext)
Using Tx As Transaction = db.TransactionManager.StartTransaction
Dim table As BlockTable = Tx.GetObject(db.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead)
Dim model As BlockTableRecord = Tx.GetObject(table(BlockTableRecord.ModelSpace), Teigha.DatabaseServices.OpenMode.ForWrite)
If Not table.Has(_blkName) Then
ed.WriteMessage(String.Format("\nPrecisa definir o bloco {0}", _blkName))
Return False
End If
ml.BlockContentId = table(_blkName)
'ml.BlockPosition = New Point3d(4, 2, 0)
Dim AttNumber As Integer = 0
Dim blkLeader As BlockTableRecord = TryCast(Tx.GetObject(ml.BlockContentId, Teigha.DatabaseServices.OpenMode.ForRead), BlockTableRecord)
Dim Transfo As Matrix3d = Matrix3d.Displacement(ml.BlockPosition.GetAsVector())
For Each blkEntId As ObjectId In blkLeader
Dim AttributeDef As AttributeDefinition = TryCast(Tx.GetObject(blkEntId, Teigha.DatabaseServices.OpenMode.ForRead), AttributeDefinition)
If AttributeDef IsNot Nothing Then
Dim AttributeRef As New AttributeReference()
AttributeRef.SetAttributeFromBlock(AttributeDef, Transfo)
AttributeRef.Position = AttributeDef.Position.TransformBy(Transfo)
Commit(AttributeRef)
ml.SetBlockAttribute(blkEntId, AttributeRef)
End If
Next
Tx.Commit()
End Using
'AddVertex()
_started = True
End If
Else
ml.Visible = True
'ml.SetLastVertex(_lineIndex, _end)
End If
Return True
End Function
Public Sub AddVertex()
Dim ml As MLeader = TryCast(Entity, MLeader)
If m_pts.Count = 0 Then
_lineIndex = ml.AddLeaderLine(_index)
ml.AddFirstVertex(_lineIndex, _start)
'ml.AddLastVertex(_lineIndex, _end)
Else
ml.AddLastVertex(_lineIndex, _end)
End If
m_pts.Add(_end)
End Sub
Public Sub RemoveLastVertex()
Dim ml As MLeader = TryCast(Entity, MLeader)
Dim dogvec As Vector3d = ml.GetDogleg(_index)
Dim doglen As Double = ml.DoglegLength * IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Cannoscale.DrawingUnits
Dim landgap As Double = ml.LandingGap
'If m_pts.Count >= 1 Then
If ml.GetLastVertex(_lineIndex).X <= ml.GetVertex(_lineIndex, ml.VerticesCount(_lineIndex) - 2).X Then
dogvec = New Vector3d(-1, 0, 0)
ml.BlockPosition = ml.GetLastVertex(_lineIndex) + ((doglen + landgap) * dogvec)
Else
dogvec = New Vector3d(1, 0, 0)
End If
'End If
End Sub
Public Function GetEntity() As Teigha.DatabaseServices.MLeader
Return TryCast(MyBase.Entity, MLeader)
End Function
Property GetObjectId As ObjectId
Public Overridable Sub Commit(AttributeRef As AttributeReference)
' nada aqui
'Select Case AttributeRef.Tag
' Case "MARCA"
' AttributeRef.TextString = _contents.Marca
' Case "QTD"
' AttributeRef.TextString = _contents.Qtde
' Case "TRATAMENTO"
' AttributeRef.TextString = _contents.Tratamento
' Case "DESCRICAO"
' AttributeRef.TextString = _contents.descricao
' Case "LISTA"
' AttributeRef.TextString = _contents.lista
'End Select
End Sub
Public Sub MyMLeaderJig()
Dim doc As Document = IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
'Dim jig As MLeaderJig = New MLeaderJig("novo_ponto", CType(blockContent.Entity, DBPoint).Position)
Dim bSuccess As Boolean = True, bComplete As Boolean = False
While bSuccess AndAlso Not bComplete
Dim dragres As PromptResult = ed.Drag(Me)
bSuccess = (dragres.Status = PromptStatus.OK)
If bSuccess Then Me.AddVertex()
bComplete = (dragres.Status = PromptStatus.None)
If bComplete Then Me.RemoveLastVertex()
End While
If bComplete Then
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = CType(tr.GetObject(db.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead, False), BlockTable)
Dim btr As BlockTableRecord = CType(tr.GetObject(bt(BlockTableRecord.ModelSpace), Teigha.DatabaseServices.OpenMode.ForWrite, False), BlockTableRecord)
btr.AppendEntity(Me.GetEntity())
tr.AddNewlyCreatedDBObject(Me.GetEntity(), True)
GetObjectId = Me.GetEntity.ObjectId
tr.Commit()
End Using
End If
End Sub
Public Overloads Sub Dispose(A As Boolean)
MyBase.Dispose(A)
If Not m_pts.IsDisposed Then
m_pts.Dispose()
End If
End Sub
End Class
End Namespace
Re: Using of Ji MLeader
#5Hi,
I don't have class XPV so try to create a new constructor for Leader class as below:
call :
Dim L As New Leader()
then L.MyMLeaderJig() works, I mean that the program not get the exception"eNotOpenForRead".
I don't have class XPV so try to create a new constructor for Leader class as below:
Code: Select all
Public Sub New()
MyBase.New("novo_ponto", Point3d.Origin)
blockContent = "blockContent"
' Store info that's passed in, but don't init the MLeader
End Sub
Dim L As New Leader()
then L.MyMLeaderJig() works, I mean that the program not get the exception"eNotOpenForRead".
Re: Using of Ji MLeader
#6I'll try that ... so post result here ... down is the code:
Code: Select all
Imports App = IntelliCAD.ApplicationServices.Application
Public Class XPV
Inherits XElement
Public isPV As Boolean
Public CT As Double
Public CF As Double
Public CTerreno As Double
Public TAG As String
Public PV As String
Public Sub New()
MyBase.New("AD PV Atributos")
isPV = False
End Sub
Public Overloads Sub Commit()
Try
Rb = New ResultBuffer
Rb.Add(New TypedValue(DxfCode.Real, CT))
Rb.Add(New TypedValue(DxfCode.Real, CF))
Rb.Add(New TypedValue(DxfCode.Real, CTerreno))
Rb.Add(New TypedValue(DxfCode.Text, PV))
Rb.Add(New TypedValue(DxfCode.Text, TAG))
MyBase.Commit()
isPV = True
Catch ex As system.Exception
App.DocumentManager.MdiActiveDocument.Editor.WriteMessage(ex.ToString)
End Try
End Sub
Public Overloads Sub Retrieve()
Try
MyBase.Retrieve()
CT = Rb(0).value
CF = Rb(1).value
CTerreno = Rb(2).value
PV = Rb(3).value
TAG = Rb(4).value
isPV = True
Catch ex As System.Exception
App.DocumentManager.MdiActiveDocument.Editor.WriteMessage(ex.ToString)
End Try
End Sub
End Class
Public MustInherit Class XElement
Private vEntity As Entity
Private entryName As String
Property Rb As ResultBuffer
Public Sub New(Name As String)
entryName = Name
Rb = New ResultBuffer
End Sub
Property Nome As String
Get
Return entryName
End Get
Set(value As String)
entryName = value
End Set
End Property
Property Entity As Entity
Get
Return vEntity
End Get
Set(value As Entity)
vEntity = value
End Set
End Property
Property Buffer As ResultBuffer
Get
Return Me.Rb
End Get
Set(value As ResultBuffer)
Me.Rb = value
End Set
End Property
Private Function GetXrecordData(ByVal id As ObjectId, tr As Transaction) As Xrecord
Dim ret As Xrecord = Nothing
Try
'Using tr As Transaction = IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction()
Dim obj As DBObject = CType(tr.GetObject(id, Teigha.DatabaseServices.OpenMode.ForRead), DBObject)
If obj.ExtensionDictionary = ObjectId.Null Then
Return Nothing
End If
Dim dict As DBDictionary = CType(tr.GetObject(obj.ExtensionDictionary, Teigha.DatabaseServices.OpenMode.ForRead), DBDictionary)
If dict.Contains(entryName) Then
ret = tr.GetObject(dict.GetAt(entryName), Teigha.DatabaseServices.OpenMode.ForRead)
Else
Return Nothing
End If
' tr.Commit()
'End Using
Catch ex As Teigha.Runtime.Exception
MsgBox(String.Format("{0} - {1} {2} {3}", System.Reflection.MethodBase.GetCurrentMethod().Name, ex.Source, ex.StackTrace, ex.Message), vbCritical)
End Try
Return ret
End Function
Public Sub Retrieve()
Try
Dim db = Intellicad.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database
Rb = Nothing
Using Lock = Intellicad.ApplicationServices.Application.DocumentManager.MdiActiveDocument.LockDocument()
Using tr = db.TransactionManager.StartTransaction()
Rb = New ResultBuffer
Dim Xrec As Xrecord = GetXrecordData(vEntity.ObjectId, tr)
If Not IsNothing(Xrec) Then
For Each KeyPair In Xrec.Data
Rb.Add(New TypedValue(KeyPair.TypeCode, KeyPair.Value))
Next
Else
Rb = Nothing
End If
End Using
End Using
Catch ex As Teigha.Runtime.Exception
MsgBox(String.Format("{0} - {1} {2} {3}", System.Reflection.MethodBase.GetCurrentMethod().Name, ex.Source, ex.StackTrace, ex.Message), vbCritical)
End Try
End Sub
Public Sub Commit()
Try
Using Intellicad.ApplicationServices.Application.DocumentManager.MdiActiveDocument.LockDocument()
Using tr = vEntity.ObjectId.Database.TransactionManager.StartTransaction()
Dim obj As Entity = CType(tr.GetObject(vEntity.ObjectId, Teigha.DatabaseServices.OpenMode.ForRead), Entity)
Dim dictId As ObjectId = obj.ExtensionDictionary
If dictId.IsNull Then
obj.UpgradeOpen()
obj.CreateExtensionDictionary()
obj.DowngradeOpen()
dictId = obj.ExtensionDictionary
End If
Dim dict As DBDictionary = tr.GetObject(dictId, Teigha.DatabaseServices.OpenMode.ForWrite)
Dim xrec As Xrecord
If dict.Contains(entryName) Then
xrec = tr.GetObject(dict.GetAt(entryName), Teigha.DatabaseServices.OpenMode.ForWrite)
Else
xrec = New Xrecord()
dict.SetAt(entryName, xrec)
tr.AddNewlyCreatedDBObject(xrec, True)
End If
xrec.Data = Rb
AddRegAppTableRecord(entryName)
Dim RbXdata As New ResultBuffer
RbXdata.Add(New TypedValue(DxfCode.ExtendedDataRegAppName, entryName))
RbXdata.Add(New TypedValue(DxfCode.ExtendedDataInteger16, 1))
vEntity.UpgradeOpen()
vEntity.XData = RbXdata
vEntity.DowngradeOpen()
tr.Commit()
End Using
End Using
Catch ex As Teigha.Runtime.Exception
MsgBox(String.Format("{0} - {1} {2} {3}", System.Reflection.MethodBase.GetCurrentMethod().Name, ex.Source, ex.StackTrace, ex.Message), vbCritical)
End Try
End Sub
End Class
Re: Using of Ji MLeader
#7Look the problem not to initiate MLeader in Mybase.New because it belongs to EntityJig wich has the Entity as the constructors and the property Entity is ReadOnly.
So the only one moment to initiate is inside the constructor to jig it after.
So the only one moment to initiate is inside the constructor to jig it after.
Code: Select all
Imports IntelliCAD.ApplicationServices
Imports IntelliCAD.EditorInput
Imports Teigha.DatabaseServices
Imports Teigha.Geometry
Imports App = IntelliCAD.ApplicationServices.Application
Namespace LeaderPlacement
Public Class MLeaderJig
Inherits EntityJig
Protected _start As Point3d, _end As Point3d
Private _index As Integer
Private _lineIndex As Integer
Protected _started As Boolean
Private _blkName As String
Private m_pts As Point3dCollection
'Private m_leaderIndex As Integer
'Private m_LeaderLineIndex As Integer
Private m_tempPoint As Point3d
Public Sub New(BlockContent As String)
MyBase.New(New MLeader())
m_pts = New Point3dCollection()
Dim ml As MLeader = GetEntity()
ml.SetDatabaseDefaults()
ml.ContentType = ContentType.BlockContent
ml.EnableDogleg = True
ml.EnableLanding = True
ml.LandingGap = 0
'_index = ml.AddLeader()
_lineIndex = -1
_started = False
_blkName = BlockContent
_index = ml.AddLeader()
'AddVertex()
End Sub
Property Start As Point3d
Get
Return _start
End Get
Set(value As Point3d)
_start = value
_end = value
End Set
End Property
' A fairly standard Sampler function
Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
Dim opts As JigPromptPointOptions = New JigPromptPointOptions()
opts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoNegativeResponseAccepted)
If m_pts.Count = 0 Then
opts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoNegativeResponseAccepted)
opts.Message = vbLf & "Start point of multileader: "
opts.UseBasePoint = False
ElseIf m_pts.Count = 1 Then
opts.BasePoint = m_pts(m_pts.Count - 1)
opts.UseBasePoint = True
opts.Message = vbLf & "Specify multileader vertex: "
ElseIf m_pts.Count > 1 Then
'opts.UserInputControls = opts.UserInputControls Or UserInputControls.NullResponseAccepted 'UserInputControls.Accept3dCoordinates Or UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect Or UserInputControls.UseBasePointElevation
opts.UserInputControls = (UserInputControls.AnyBlankTerminatesInput Or UserInputControls.NoNegativeResponseAccepted Or
UserInputControls.Accept3dCoordinates Or UserInputControls.AcceptMouseUpAsPoint Or UserInputControls.NullResponseAccepted Or UserInputControls.AcceptOtherInputString Or
UserInputControls.GovernedByUCSDetect Or UserInputControls.GovernedByOrthoMode Or UserInputControls.InitialBlankTerminatesInput Or UserInputControls.NoZeroResponseAccepted)
opts.BasePoint = m_pts(m_pts.Count - 1)
opts.UseBasePoint = True
opts.SetMessageAndKeywords(vbLf & "Specify multileader vertex or : [End]", "End")
'opts.Message = vbLf & "Specify multileader vertex: "
Else
Return SamplerStatus.Cancel
End If
Dim res As PromptPointResult = prompts.AcquirePoint(opts)
If _end = res.Value Then
Return SamplerStatus.NoChange
ElseIf res.Status = PromptStatus.OK Then
_end = res.Value
Return SamplerStatus.OK
End If
Return SamplerStatus.Cancel
End Function
Protected Overrides Function Update() As Boolean
Dim ml = DirectCast(Entity, MLeader)
If m_pts.Count > 0 Then
ml.SetLastVertex(_lineIndex, _end)
Dim _dl = New Vector3d(If(_end.X <= m_pts(m_pts.Count - 1).X, -1, 1), 0, 0)
Dim doglen As Double = ml.DoglegLength * IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Cannoscale.DrawingUnits
Dim landgap As Double = ml.LandingGap
If _end.X <= m_pts(m_pts.Count - 1).X Then
ml.EnableDogleg = True
ml.SetDogleg(_lineIndex, _dl)
ml.BlockPosition = _end + ((doglen + landgap) * _dl)
Else
ml.EnableDogleg = False
ml.BlockPosition = _end
End If
End If
If Not _started Then
If _start.DistanceTo(_end) > Tolerance.[Global].EqualPoint Then
Dim doc As Document = App.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
ml.ContentType = ContentType.BlockContent
Dim ocm = db.ObjectContextManager
Dim occ = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
ml.AddContext(occ.CurrentContext)
Using Tx As Transaction = db.TransactionManager.StartTransaction
Dim table As BlockTable = Tx.GetObject(db.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead)
Dim model As BlockTableRecord = Tx.GetObject(table(BlockTableRecord.ModelSpace), Teigha.DatabaseServices.OpenMode.ForWrite)
If Not table.Has(_blkName) Then
ed.WriteMessage(String.Format("\nPrecisa definir o bloco {0}", _blkName))
Return False
End If
ml.BlockContentId = table(_blkName)
'ml.BlockPosition = New Point3d(4, 2, 0)
Dim AttNumber As Integer = 0
Dim blkLeader As BlockTableRecord = TryCast(Tx.GetObject(ml.BlockContentId, Teigha.DatabaseServices.OpenMode.ForRead), BlockTableRecord)
Dim Transfo As Matrix3d = Matrix3d.Displacement(ml.BlockPosition.GetAsVector())
For Each blkEntId As ObjectId In blkLeader
Dim AttributeDef As AttributeDefinition = TryCast(Tx.GetObject(blkEntId, Teigha.DatabaseServices.OpenMode.ForRead), AttributeDefinition)
If AttributeDef IsNot Nothing Then
Dim AttributeRef As New AttributeReference()
AttributeRef.SetAttributeFromBlock(AttributeDef, Transfo)
AttributeRef.Position = AttributeDef.Position.TransformBy(Transfo)
Commit(AttributeRef)
ml.SetBlockAttribute(blkEntId, AttributeRef)
End If
Next
Tx.Commit()
End Using
AddVertex()
_started = True
End If
Else
ml.Visible = True
'ml.SetLastVertex(_lineIndex, _end)
End If
Return True
End Function
Public Sub AddVertex()
Dim ml As MLeader = TryCast(Entity, MLeader)
If m_pts.Count = 0 Then
_lineIndex = ml.AddLeaderLine(_index)
ml.AddFirstVertex(_lineIndex, _start)
'ml.AddLastVertex(_lineIndex, _end)
Else
ml.AddLastVertex(_lineIndex, _end)
End If
m_pts.Add(_end)
End Sub
Public Sub RemoveLastVertex()
Dim ml As MLeader = TryCast(Entity, MLeader)
Dim dogvec As Vector3d = ml.GetDogleg(_index)
Dim doglen As Double = ml.DoglegLength * IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Cannoscale.DrawingUnits
Dim landgap As Double = ml.LandingGap
'If m_pts.Count >= 1 Then
If ml.GetLastVertex(_lineIndex).X <= ml.GetVertex(_lineIndex, ml.VerticesCount(_lineIndex) - 2).X Then
dogvec = New Vector3d(-1, 0, 0)
ml.BlockPosition = ml.GetLastVertex(_lineIndex) + ((doglen + landgap) * dogvec)
Else
dogvec = New Vector3d(1, 0, 0)
End If
'End If
End Sub
Public Function GetEntity() As Teigha.DatabaseServices.MLeader
Return TryCast(MyBase.Entity, MLeader)
End Function
Property GetObjectId As ObjectId
Public Overridable Sub Commit(AttributeRef As AttributeReference)
' nada aqui
'Select Case AttributeRef.Tag
' Case "MARCA"
' AttributeRef.TextString = _contents.Marca
' Case "QTD"
' AttributeRef.TextString = _contents.Qtde
' Case "TRATAMENTO"
' AttributeRef.TextString = _contents.Tratamento
' Case "DESCRICAO"
' AttributeRef.TextString = _contents.descricao
' Case "LISTA"
' AttributeRef.TextString = _contents.lista
'End Select
End Sub
Public Sub MyMLeaderJig()
Dim doc As Document = IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
'Dim jig As MLeaderJig = New MLeaderJig("novo_ponto", CType(blockContent.Entity, DBPoint).Position)
Dim bSuccess As Boolean = True, bComplete As Boolean = False
While bSuccess AndAlso Not bComplete
Dim dragres As PromptResult = ed.Drag(Me)
bSuccess = (dragres.Status = PromptStatus.OK)
If bSuccess Then Me.AddVertex()
bComplete = (dragres.Status = PromptStatus.None)
If bComplete Then Me.RemoveLastVertex()
End While
If bComplete Then
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = CType(tr.GetObject(db.BlockTableId, Teigha.DatabaseServices.OpenMode.ForRead, False), BlockTable)
Dim btr As BlockTableRecord = CType(tr.GetObject(bt(BlockTableRecord.ModelSpace), Teigha.DatabaseServices.OpenMode.ForWrite, False), BlockTableRecord)
btr.AppendEntity(Me.GetEntity())
tr.AddNewlyCreatedDBObject(Me.GetEntity(), True)
GetObjectId = Me.GetEntity.ObjectId
tr.Commit()
End Using
End If
End Sub
Public Overloads Sub Dispose(A As Boolean)
MyBase.Dispose(A)
If Not m_pts.IsDisposed Then
m_pts.Dispose()
End If
End Sub
End Class
End Namespace
Re: Using of Ji MLeader
#8I tried the change ... did not work. Steel have GetEntity call returning the entity is eNotOpenForRead. I had check it with debugger and all fields have Exception generated by Teigha.DatabaseServices like that.
Steel working ...
Steel working ...