Public Function InsertBlock(ByVal InsPt As Geometry.Point3d, ByVal BlockName As String, ByVal Scl As Scale3d, ByVal lObj As String, Optional ByVal Rot As Double = 0) As DatabaseServices.ObjectId
Dim myBlockRef As BlockReference = Nothing
Try
Dim myDB As Database = HostApplicationServices.WorkingDatabase
Using myTrans As Transaction = myDB.TransactionManager.StartTransaction
Dim myBT As BlockTable = myDB.BlockTableId.GetObject(OpenMode.ForRead)
Dim myBTR As BlockTableRecord = myBT(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForWrite)
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'Вставляем блок
Dim myBlockDef As BlockTableRecord = myBT(BlockName).GetObject(OpenMode.ForRead)
myBlockRef = New DatabaseServices.BlockReference(InsPt, myBT(BlockName))
myBlockRef.ScaleFactors = Scl
myBlockRef.Rotation = Rot
myBlockRef.Layer = lObj
myBTR.AppendEntity(myBlockRef)
myTrans.AddNewlyCreatedDBObject(myBlockRef, True)
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'Читаем атрибуты блока
Dim myAttColl As DatabaseServices.AttributeCollection
Dim myEnt As DatabaseServices.Entity
myAttColl = myBlockRef.AttributeCollection
For Each entID As ObjectId In myBlockDef
myEnt = entID.GetObject(OpenMode.ForWrite)
If TypeOf myEnt Is DatabaseServices.AttributeDefinition Then 'если это атрибут
'делаем на него ссылку
Dim myAttDef As DatabaseServices.AttributeDefinition = myEnt
'создаем новый атрибут
Dim myAttRef As New DatabaseServices.AttributeReference
'копируем значения в новый атрибут
myAttRef.SetAttributeFromBlock(myAttDef, myBlockRef.BlockTransform)
myAttRef.Position = myAttDef.Position.TransformBy(myBlockRef.BlockTransform)
myAttRef.TextString = myAttDef.TextString
myAttRef.Tag = myAttDef.Tag
myAttColl.AppendAttribute(myAttRef)
'проверяем атрибут на наличие поля
If myAttDef.HasFields = True Then
Dim id As ObjectId = myAttDef.GetField() 'смотрим старый атрибут
Dim fd As Field = myTrans.GetObject(id, OpenMode.ForRead) 'читаем его
Dim CodStrFiled As String = fd.GetFieldCode 'получаем код поля
Dim StrFind As String = "InsertionPoint \f " & """" & "%lu2%pt4"
Dim ind As Integer = CodStrFiled.IndexOf(StrFind)
If ind <> -1 Then
Dim str1 As String = "%<\AcObjProp Object(%<\_ObjId "
Dim strID As String = myBlockRef.Id.ToString() 'получаем id вновь созданного блока
strID = Mid(strID, 2, strID.Length - 2) 'убираем из строки первую и последние скобки
Dim str2 As String = ">%).InsertionPoint \f " & """" & "%lu2%pt4%pr2" & """" & ">%"
Dim str As String = str1 + strID + str2
Dim Z As Point3d = myBlockRef.Position
Dim fldstr As String = String.Format(str, Z.ToString())
Dim field As Field = New Field(fldstr)
field.Evaluate()
Dim fieldEval As FieldEvaluationStatusResult = field.EvaluationStatus
If fieldEval.Status = FieldEvaluationStatus.Success Then
myAttRef.SetField(field)
myTrans.AddNewlyCreatedDBObject(field, True)
Else
Dim Otm As Double = Math.Round(InsPt.Z, 2)
myAttDef.TextString = String.Format(CultureInfo.InvariantCulture, "{0:0.00}", Otm)
End If
End If
End If
myTrans.AddNewlyCreatedDBObject(myAttRef, True)
'If tagOtm Like "ОТМЕТКА_ЗЕМЛИ" Or tagOtm Like "ОТМЕТКА_ЦЕНТРА" Or tagOtm Like "ОТМЕТКА_КОЛЬЦА" Or tagOtm Like "ОТМЕТКА_ВЫСОТ" Or tagOtm Like "ОТМЕТКА_УРЕЗА_ВОДЫ" Then
'Dim Otm As Double = Math.Round(InsPt.Z, 2)
'myAttDef.TextString = String.Format(CultureInfo.InvariantCulture, "{0:0.00}", Otm)
'End If
End If
Next
myTrans.Commit()
End Using
Catch ex As Exception
End Try
Return myBlockRef.ObjectId
End Function
End Class
