Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Public NotInheritable Class ChangeBlocks
Private Shared MObject As String
Private Shared Factor As Double
Private Shared Modification As String
Private Shared Type As String
Private Shared TypedValues(0) As TypedValue
Private Shared AcSelFtr As SelectionFilter
Private Shared LFormat As String
Public Shared Sub ChengeBlock()
MObject = GetSetting("AMR LISP", "Chenge Block", "Object", "ALL")
Factor = GetSetting("AMR LISP", "Chenge Block", "Factor", "0")
Type = GetSetting("AMR LISP", "Chenge Block", "Type", "Text")
LFormat = GetSetting("AMR LISP", "Check Level", "Format", "0.00")
' create selection filter with typedvalues
'Dim TypedValues(0) As TypedValue
If MObject = "All" Then
TypedValues.SetValue(New TypedValue(DxfCode.Start, "INSERT"), 0)
Else
TypedValues.SetValue(New TypedValue(DxfCode.BlockName, MObject), 0)
End If
AcSelFtr = New SelectionFilter(TypedValues)
'create keywords options for selection
Dim AcSelOption As PromptSelectionOptions = New PromptSelectionOptions
AcSelOption.Keywords.Add("Object")
AcSelOption.Keywords.Add("FActor")
AcSelOption.Keywords.Add("FOrmat")
AcSelOption.Keywords.Add("Type")
AcSelOption.MessageForAdding = (vbLf & "Select Object(s) or " & AcSelOption.Keywords.GetDisplayString(True))
AcSelOption.Keywords.Default = "Object"
AddHandler AcSelOption.KeywordInput, AddressOf handle_KeywordInput
Dim AcSelResult As PromptSelectionResult = Application.DocumentManager.MdiActiveDocument.Editor.GetSelection(AcSelOption, AcSelFtr)
Dim Tr As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction()
If AcSelResult.Status = PromptStatus.OK Then
If Type = "Text" Then
If ChangeText(AcSelResult.Value) = False Then
Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & "invalid operation, try again")
End If
Else
If EditScale(AcSelResult.Value) = False Then
Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & "invalid operation, try again")
End If
End If
End If
Tr.Commit()
Tr.Dispose()
Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & "done")
End Sub
Private Shared Function ChangeText(MySelSet As SelectionSet) As Boolean
Dim Tr As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction()
If MySelSet IsNot Nothing Then
For Each BlKID In MySelSet.GetObjectIds()
Dim BlkRef As BlockReference = Tr.GetObject(BlKID, OpenMode.ForWrite)
If BlkRef.AttributeCollection.Count > 0 Then
Dim objId As ObjectId = BlkRef.AttributeCollection.Item(0)
Dim attRef As AttributeReference = Tr.GetObject(objId, OpenMode.ForWrite)
Dim Value As Double = Val(attRef.TextString) + Factor
If Value = 0 Then
attRef.TextString = "±" & Format(Value, LFormat)
ElseIf Value > 0 Then
attRef.TextString = "+" & Format(Value, LFormat)
ElseIf Value < 0 Then
attRef.TextString = Format(Value, LFormat)
End If
End If
Next
End If
Tr.Commit()
Tr.Dispose()
Return True
End Function
Private Shared Function EditScale(MySelSet As SelectionSet) As Boolean
Dim Tr As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction()
If MySelSet IsNot Nothing Then
For Each BlKID In MySelSet.GetObjectIds()
Dim BlkRef As BlockReference = Tr.GetObject(BlKID, OpenMode.ForWrite)
If Factor > 0 Then
BlkRef.TransformBy(Matrix3d.Scaling(Factor, BlkRef.Position))
Else
Return False
End If
Next
End If
Tr.Commit()
Tr.Dispose()
Return True
End Function
Private Shared Sub handle_KeywordInput(ByVal sender As Object, ByVal e As SelectionTextInputEventArgs)
Select Case e.Input
Case "Object"
Dim Trans As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction()
Dim AcEntOption As PromptEntityOptions = New PromptEntityOptions(vbLf & "Select base object")
AcEntOption.Keywords.Add("All")
AcEntOption.Keywords.Add(MObject)
AcEntOption.Keywords(1).Visible = False
AcEntOption.Keywords.Default = MObject
AcEntOption.SetRejectMessage(vbLf & "You must pick a block , try again ...")
AcEntOption.AddAllowedClass(GetType(BlockReference), True)
Dim AcEntResult As PromptEntityResult = Application.DocumentManager.MdiActiveDocument.Editor.GetEntity(AcEntOption)
If AcEntResult.Status = PromptStatus.OK Then
Dim Obj As DBObject = Trans.GetObject(AcEntResult.ObjectId, OpenMode.ForRead)
If TypeOf (Obj) Is BlockReference Then
Dim Source As BlockReference = Obj
MObject = Source.Name
SaveSetting("AMR LISP", "Chenge Block", "Object", MObject)
'TypedValues.SetValue(New TypedValue(DxfCode.Start, MObject), 0)
'AcSelFtr = New SelectionFilter(TypedValues)
End If
ElseIf AcEntResult.Status = PromptStatus.Keyword Then
Select Case AcEntResult.StringResult
Case "All"
MObject = "All"
SaveSetting("AMR LISP", "Chenge Block", "Object", MObject)
'TypedValues.SetValue(New TypedValue(DxfCode.BlockName, MObject), 0)
'AcSelFtr = New SelectionFilter(TypedValues)
End Select
Else
Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & "you are selected unsupported object")
End If
Trans.Commit()
Trans.Dispose()
Case "FActor"
L2: Dim AcDblOption As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "Enter the calculation unit (Meter Unit) ")
AcDblOption.AllowNone = False
AcDblOption.DefaultValue = Factor
If Type = "Text" Then
AcDblOption.AllowNegative = True
Else
AcDblOption.AllowNegative = False
End If
Dim AcDblResult As PromptDoubleResult = Application.DocumentManager.MdiActiveDocument.Editor.GetDouble(AcDblOption)
If AcDblResult.Status = PromptStatus.OK Then
If Type = "Size" And AcDblResult.Value <= 0 Then
Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & "Value must be positive.")
GoTo L2
End If
Factor = AcDblResult.Value
SaveSetting("AMR LISP", "Chenge Block", "Factor", Factor)
Else
End If
Case "Type"
Dim AcKwrdOption2 As PromptKeywordOptions = New PromptKeywordOptions(vbLf & "Which method you will use [Text/Size] : ", "Text Size")
AcKwrdOption2.Keywords.Default = Type
Dim AcKwrdResult2 As PromptResult = Application.DocumentManager.MdiActiveDocument.Editor.GetKeywords(AcKwrdOption2)
If AcKwrdResult2.Status = PromptStatus.OK Then
Type = AcKwrdResult2.StringResult
SaveSetting("AMR LISP", "Chenge Block", "Type", Type)
End If
Case "FOrmat"
Dim AcStrOption As PromptStringOptions = New PromptStringOptions("Enter text format that you want :")
AcStrOption.DefaultValue = LFormat
Dim AcStrResult As PromptResult = Application.DocumentManager.MdiActiveDocument.Editor.GetString(AcStrOption)
If AcStrResult.Status = PromptStatus.OK Then
LFormat = AcStrResult.StringResult
SaveSetting("AMR LISP", "Chenge Block", "Format", LFormat)
End If
End Select
End Sub
End Class
this code can edit all block size , or block attributes text
my problem if the user while selection change the block name , so i need to apply the new filter to current selection ,
or cancel selection by code, or any solution to fix this problem
