I am using below code to add attribute to certain block,
But it does not work, I am not getting what exactly going wrong and there is no error.
Public Class addattribute
Public Function addnewattribute()
Dim attdef As New AttributeReference
Dim templatepath As String = "C:\Users\sesa388372\Documents\Visual Studio 2015\Projects\SchneiderMacros\Wtemplate.DWG"
Dim db As Database = New Database
db.ReadDwgFile(templatepath, System.IO.FileShare.ReadWrite, False, "")
Using tr As Transaction = db.TransactionManager.StartTransaction
attdef.SetDatabaseDefaults(db)
attdef.Tag = "Cell location"
attdef.TextString = "AAA"
Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForWrite)
Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.PaperSpace), OpenMode.ForWrite)
For Each objid As ObjectId In btr
If objid.ObjectClass.Name = "AcDbBlockReference" Then
Dim blkref As BlockReference = tr.GetObject(objid, OpenMode.ForWrite)
If blkref.Name = "TB-D-ATTR" Then
blkref.AttributeCollection.AppendAttribute(attdef)
End If
End If
Next
tr.AddNewlyCreatedDBObject(attdef, True)
tr.Commit()
End Using
Return Nothing
End Function
End Class
I believe the main problem are the BlockReference location and that you did not save the file. I made some adjusts on the code, but could not fully test it, check the comments below.
Public Sub addnewattribute() ' don't you mean define as Sub?
Dim templatepath As String = "C:\Users\sesa388372\Documents\Visual Studio 2015\Projects\SchneiderMacros\Wtemplate.DWG"
' you must dispose this side database, the 'using' will take care of it
Using db As Database = New Database(False, True) ' specify the parameters
db.ReadDwgFile(templatepath, System.IO.FileShare.ReadWrite, False, "")
db.CloseInput() ' this should help the Save() method
Using tr As Transaction = db.TransactionManager.StartTransaction
Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForWrite)
Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.PaperSpace), OpenMode.ForWrite)
For Each objid As ObjectId In btr
If objid.ObjectClass.Name = "AcDbBlockReference" Then
Dim blkref As BlockReference = tr.GetObject(objid, OpenMode.ForWrite)
If blkref.Name = "TB-D-ATTR" Then
' define this variable inside the loop, you cannot reuse it
Dim attdef As New AttributeReference
attdef.SetDatabaseDefaults(db)
attdef.Tag = "Cell location"
attdef.TextString = "AAA"
attdef.SetAttributeFromBlock(blkref.BlockTransform) ' adjust the location
blkref.AttributeCollection.AppendAttribute(attdef)
tr.AddNewlyCreatedDBObject(attdef, True)
End If
End If
Next
tr.Commit()
End Using
'Return Nothing ' in this case, a Sub (instead function) should be better
db.Save() ' did you miss to save changes?
End Using
End Sub
I notice you're trying to add an AttributeDefinition to a Block Reference.
You'll need to add the AttributeDefinition to the BlockTableRecord and then update the AttributeReference in the BlockReference.
See here for more info: http://adndevblog.typepad.com/autocad/2012/07/changing-block-definition-of-an-block-reference.html
Also, are you running the ATTSYNC command after to make sure your block reference is displaying correctly?
Related
I'm trying to insert a block from another file and then change the layer of the block. I can get the block to insert into the modelspace but can't find a way to change it's layer. I'm hoping someone can help me out with the below code.
Thanks in advance.
<CommandMethod("AddHardware")>
Public Shared Sub Add_Hardware()
Dim doc As Document = AutoCADApp.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim pStrOpts As PromptStringOptions = New PromptStringOptions("NewFilename")
pStrOpts.AllowSpaces = True
Dim FileName As PromptResult = ed.GetString(pStrOpts)
Dim Layer As String = ed.GetString("Layer").StringResult
Dim ObjId As ObjectId
Dim bt As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead)
Dim btr As BlockTableRecord = bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForWrite)
Using dbInsert As New Database(False, True)
dbInsert.ReadDwgFile(FileName.StringResult, IO.FileShare.Read, True, "")
ObjId = db.Insert(Path.GetFileNameWithoutExtension(FileName.StringResult), dbInsert, True)
End Using
Dim curUCSMatrix As Matrix3d = doc.Editor.CurrentUserCoordinateSystem
Dim curUCS As CoordinateSystem3d = curUCSMatrix.CoordinateSystem3d
Dim BlkRef As New BlockReference(New Point3d(PositionX, PositionY, PositionZ), ObjId)
BlkRef.TransformBy(Matrix3d.Rotation(RotateX, curUCS.Xaxis, New Point3d(PositionX, PositionY, PositionZ)))
BlkRef.TransformBy(Matrix3d.Rotation(RotateY, curUCS.Yaxis, New Point3d(PositionX, PositionY, PositionZ)))
BlkRef.TransformBy(Matrix3d.Rotation(RotateZ, curUCS.Zaxis, New Point3d(PositionX, PositionY, PositionZ)))
btr.AppendEntity(BlkRef)
tr.AddNewlyCreatedDBObject(BlkRef, True)
tr.Commit()
End Using
End Sub
To change the layer of the block reference, simply set its Layer (or LayerId) property.
BlkRef.Layer = LayerName
I’m trying to obtain the layer, location, value, height, width and style for each DBText value in the current open drawing. So far I've only been able to get objectIDs.
Function SelectAllText(dbIn As Database) As ObjectIdCollection
Using doclock = Application.DocumentManager.MdiActiveDocument.LockDocument
Dim retIDs As New ObjectIdCollection
Using tr As Transaction = dbIn.TransactionManager.StartTransaction
Dim bt As BlockTable = dbIn.BlockTableId.GetObject(OpenMode.ForRead)
For Each btrID As ObjectId In bt
Dim btr As BlockTableRecord = TryCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)
For Each TRefID As ObjectId In btr
Dim te = TryCast(tr.GetObject(TRefID, OpenMode.ForRead), DBText),
tid = te.ObjectId
retIDs.Add(tid)
Next
Next
End Using
Return retIDs
End Using
End Function
The approache you proposed should work, basically in the same way: iterating through the Database>BlockTable>BlockTableRecord(ModelSpace)>All Entities.
With the ObjectId of each DBText you can:
Dim acText as DBText = tr.GetObject(dbTextId, OpenMode.ForRead)
Dim positionPoint as Point3d = acText.Position
Dim height as Double = acText.Height
Dim content as String = acText.TextString
Can any one explain me to get the object entites count of the layer
using vba code acad
I think You should use SelectionSets
Public Sub SelsetByLayer()
Dim ss As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
FilterType(0) = 8 ' DXF code of Layer property
For I = 0 To ThisDrawing.Layers.Count
' ThisDrawing.SelectionSets.Item(0).Delete
Set ss = ThisDrawing.SelectionSets.Add("test") ' You need to ensure if such selection set not exist yet .
FilterData(0) = ThisDrawing.Layers.Item(I).Name
ss.Select acSelectionSetAll, , , FilterType, FilterData
Next
End Sub
Further to the original answer, about using selection sets.
Here it is slightly modified:
Public Sub SelsetByLayer()
Dim ss As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
FilterType(0) = 8 ' DXF code of Layer property
For I = 0 To ThisDrawing.Layers.Count
Set ss = CreateSelectionSet("test")
FilterData(0) = ThisDrawing.Layers.Item(I).Name
ss.Select acSelectionSetAll, , , FilterType, FilterData
Next
End Sub
Public Function CreateSelectionSet(SelName As String) As AcadSelectionSet
On Error Resume Next
' Create a new selection set
' Delete any existing selection set with the specified name
With ThisDrawing
Set CreateSelectionSet = .SelectionSets.Add(SelName)
If (Err.Number <> 0) Then
Err.Clear
.SelectionSets.Item(SelName).Delete
Set CreateSelectionSet = .SelectionSets.Add(SelName)
End If
End With
End Function
I have added in the missing method for managing the deletion of existing selection set.
ss.Count will have the number of entities found. But please bear in mind that you may have layers frozen off etc. in the drawing and I think these will be excluded from the totals.
I am new to Visual Basic.
I wonder if I wanna generate multiple files in a while loop. It seems that the FILESTREAM cannot be reused even I set it into nothing at the end of loop.
Dim fs as FILESTREAM = nothing
Dim i as integer = 0
Dim path as string = "c:\users\...\Desktop\"
Dim name as string = nothing
while i<10
name = path + i.tostring
fs=File.Create(name)
i+=1
fs=nothing
end while
Thank you very much!
It's not clear if you're using the FileStream just to create a blank file or if you're planning on performing other operations against the new files. If you're just trying to create empty files and manipulate them later, after creation, then this should work:
Sub Main()
Dim i As Integer = 0
' You can use properties of My.Computer to find the current user's Desktop
Dim path As String = My.Computer.FileSystem.SpecialDirectories.Desktop
Dim fileName As String = String.Empty
While i < 10
fileName = path & "\" & i.ToString
System.IO.File.Create(fileName)
i += 1
End While
End Sub
I have a a problem with my vb.net.
my code
class business{
buiding as string
}
I load data from mongodb
Dim collection1 = db1.GetCollection(Of business)("tablebusiness")
Dim list = collection1.Find(query1)
For Each abiz In list
Dim biztemp = abiz
biztemp.buiding = nothing '//// (but I get biztemp.building = "") why??
'biztemp.building = "" here
Next