Imports System
Imports System.Collections.Generic
Imports System.Text
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.GraphicsInterface
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.EditorInput
Imports System.IO
Imports System.Security.Cryptography
Imports Autodesk.AutoCAD.Windows
Imports System.Windows.Interop
Module AutoCADFunctions
Public Sub InsertBlock(BlkName As String)
Dim bRollup As Boolean = ps.AutoRollUp
If ps.Dock.Equals(DockSides.None) Then
If ps.Style.Equals(32) Then
ps.Style = 0
End If
With ps
.AutoRollUp = True
.Visible = False
.Visible = True
End With
ps.AutoRollUp = bRollup
End If
BlkName = Duct_Shape & "_" & BlkName
Dim FullPath As String = Directory.GetCurrentDirectory & "\Blocks\" & BlkName & ".dwg"
Using xDb As New Database(False, True)
xDb.ReadDwgFile(FullPath, FileShare.Read, True, Nothing)
Using DocLock As DocumentLock = doc.LockDocument
Try
Dim Id As ObjectId = db.Insert(BlkName, xDb, True)
If Id.IsNull Then
ed.WriteMessage(vbLf & "Failed to insert block")
Return
End If
Using tr As Transaction = db.TransactionManager.StartTransaction()
Try
Dim bt As BlockTable =
DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
If Not bt.Has(BlkName) Then
ed.WriteMessage(vbLf & "Block '{0}' not found.", BlkName)
Return
End If
Dim pr As PromptResult
Using br As New BlockReference(Point3d.Origin, bt(BlkName))
br.TransformBy(ed.CurrentUserCoordinateSystem)
' Using InsertBlockJig class to insert the block
Dim insertJig As New InsertBlockJig(br)
pr = ed.Drag(insertJig)
If pr.Status <> PromptStatus.OK Then
Return
End If
' Using RotateBlockJig class to rotate the block
Dim rotateJig As New RotateBlockJig(br)
pr = ed.Drag(rotateJig)
If pr.Status <> PromptStatus.OK Then
Return
End If
rotateJig.UpdateRotation()
Dim btr As BlockTableRecord =
DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
btr.AppendEntity(br)
tr.AddNewlyCreatedDBObject(br, True)
If Not IsNothing(btr) Then
btr.UpdateAnonymousBlocks()
End If
tr.Commit()
Dim Prop As DynamicBlockReferenceProperty = GetProperty(br, "DUCT_1")
If Not IsNothing(Prop) Then
ed.WriteMessage(vbCrLf & "Property: " & Prop.PropertyName & " set successfully to value of: " & Prop.Value.ToString)
Else
ed.WriteMessage(vbCrLf & "Could not find DUCT_1 property in block " & br.Name)
End If
End Using
Catch Ex As System.AccessViolationException
End Try
End Using
Catch Ex As System.AccessViolationException
End Try
End Using
End Using
Duct_Distance = 0
End Sub
Public Sub SetProperty(BlockRef As BlockReference, PropName As String, NewValue As Object)
Dim Prop As DynamicBlockReferenceProperty = GetProperty(BlockRef, PropName)
If Not IsNothing(Prop) Then
If Not Prop.Value.Equals(NewValue) Then ' Check if the values are different
Try
' Use Convert.ChangeType to convert NewValue to the property's data type
Prop.Value = Convert.ChangeType(NewValue, Prop.Value.GetType())
Catch ex As System.Exception
' Handle conversion error or unsupported data type
' You can log an error or provide a custom error message
Console.WriteLine("Error: " & ex.Message)
End Try
End If
End If
End Sub
Public Function GetProperty(BlockRef As BlockReference, PropName As String) As DynamicBlockReferenceProperty
If BlockRef.IsDynamicBlock Then
For Each Prop As DynamicBlockReferenceProperty In BlockRef.DynamicBlockReferencePropertyCollection
If Not Prop.ReadOnly Then
If Prop.PropertyName.ToLower = PropName.ToLower Then
Return Prop
End If
End If
Next
End If
Return Nothing
End Function
Public Sub SetDuct(br As BlockReference)
If Duct_Distance > 0 Then
SetProperty(br, "DUCT_1", Duct_Distance)
End If
End Sub
Sub forsafekeeping(br As BlockReference)
If Duct_Width > 0 Then
If Insulation_KeepClear Then
SetProperty(br, "SIZE_1", Duct_Width + Insulation_Clear_Size)
Else
SetProperty(br, "SIZE_1", Duct_Width)
End If
End If
SetProperty(br, "INSULATION", Insulation_Type)
If Insulation_Type <> "NONE" Then
If Insulation_Internal_Size > 0 Then
SetProperty(br, "INSULATION_INTERNAL", Insulation_Internal_Size)
End If
If Insulation_External_Size > 0 Then
SetProperty(br, "INSULATION_EXTERNAL", Insulation_External_Size)
End If
End If
End Sub
End Module
Class InsertBlockJig
Inherits EntityJig
' Protected fields
Protected position As Point3d
Protected br As BlockReference
' Constructor (fields initialization)
Public Sub New(br As BlockReference)
MyBase.New(br)
Me.br = br
Me.position = br.Position
End Sub
' Prompts the user to specify the insertion point (EntityJig implementation)
Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
Dim msg As String = vbLf & "Specify the insertion point: "
Dim jppo As New JigPromptPointOptions(msg)
jppo.UserInputControls = (UserInputControls.Accept3dCoordinates Or
UserInputControls.NullResponseAccepted)
Dim ppr As PromptPointResult = prompts.AcquirePoint(jppo)
If Me.position.DistanceTo(ppr.Value) < Tolerance.[Global].EqualPoint Then
Return SamplerStatus.NoChange
Else
SetDuct(Me.br)
Me.position = ppr.Value
End If
Return SamplerStatus.OK
End Function
' Updates the bloc position (EntityJig implementation)
Protected Overrides Function Update() As Boolean
Me.br.Position = Me.position
Return True
End Function
End Class
Class RotateBlockJig
Inherits EntityJig
' Private fields
Protected br As BlockReference
Protected rot As Double, ucsRot As Double
' Constructor
Public Sub New(br As BlockReference)
MyBase.New(br)
Me.br = br
Me.ucsRot = br.Rotation
End Sub
' Prompts the user to specify the rotation (EntityJig implementation)
Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
Dim BasePoint As Point3d = Me.br.Position
Dim jpao As New JigPromptPointOptions(vbLf & "Specify Duct EndPoint: ")
'JigPromptAngleOptions(vbLf & "Specify the rotation: ")
jpao.DefaultValue = BasePoint
jpao.UseBasePoint = True
jpao.BasePoint = BasePoint
jpao.Cursor = CursorType.RubberBand
jpao.UserInputControls = (UserInputControls.Accept3dCoordinates Or
UserInputControls.UseBasePointElevation Or
UserInputControls.NullResponseAccepted)
Dim pt As PromptPointResult = prompts.AcquirePoint(jpao)
Dim NewPt As Point3d = pt.Value
Dim Pt1 As New Point2d(BasePoint.X, BasePoint.Y)
Dim Pt2 As New Point2d(NewPt.X, NewPt.Y)
Dim NewAngle As Double = Pt1.GetVectorTo(Pt2).Angle
Duct_Distance = Pt1.GetDistanceTo(Pt2)
SetDuct(Me.br)
If Me.rot = NewAngle Then
Return SamplerStatus.NoChange
Else
Me.rot = NewAngle
Return SamplerStatus.OK
End If
End Function
' Updates the bloc rotation (EntityJig implementation)
Protected Overrides Function Update() As Boolean
UpdateRotation()
Return True
End Function
' Updates the bloc rotation (mandatory for the 'default' option)
' This method is called from the method where the jig is created
Friend Sub UpdateRotation()
Me.br.Rotation = Me.rot + Me.ucsRot
'SetDuct(Me.br)
End Sub
End Class
