Insert AutoCAD Block on a specific layer VB.NET - vb.net

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

Related

how to Insert all datagrid rows in one time to sql data?

i use this code in my project to save datagrid rows to sql database but it work if there is no more than one row ! because i want use it in (Sales invoice form)
What change do I need ?
' in datagrid this code save one row only
Dim SaveCmd1 As SqlCommand = Zsqlcon.CreateCommand()
SaveCmd1.CommandText = ("insert into InvoicesDbTb2(IteSName,IteSSizeUnit,IteSCont,IteSPri,IteSTotContPri,IteSTask,IteSTotlAmnt) values
(#IteSName,#IteSSizeUnit,#IteSCont,#IteSPri,#IteSTotContPri,#IteSTask,#IteSTotlAmnt)")
For i As Integer = 0 To SellingDGView.Rows.Count - 2
Dim unused = SaveCmd1.Parameters.AddWithValue("#IteSName", SellingDGView.Rows(i).Cells(0).Value.ToString())
Dim unused3 = SaveCmd1.Parameters.AddWithValue("#IteSSizeUnit", SellingDGView.Rows(i).Cells(1).Value.ToString())
Dim unused4 = SaveCmd1.Parameters.AddWithValue("#IteSCont", SellingDGView.Rows(i).Cells(2).Value.ToString())
Dim unused5 = SaveCmd1.Parameters.AddWithValue("#IteSPri", SellingDGView.Rows(i).Cells(3).Value.ToString())
Dim unused6 = SaveCmd1.Parameters.AddWithValue("#IteSTotContPri", SellingDGView.Rows(i).Cells(4).Value.ToString())
Dim unused7 = SaveCmd1.Parameters.AddWithValue("#IteSTask", SellingDGView.Rows(i).Cells(5).Value.ToString())
Dim unused8 = SaveCmd1.Parameters.AddWithValue("#IteSTotlAmnt", SellingDGView.Rows(i).Cells(6).Value.ToString())
Next
You need to include part of the sql command building inside the loop.
P.S, although I’m not going to check for them here, there are limits on how many parameters and how long the sql command text can b (~2000 and ~8k respectively).
' in datagrid this code save one row only
Dim SaveCmd1 As SqlCommand = Zsqlcon.CreateCommand()
Dim sb as new StringBuilder
Sb.appendLine("insert into InvoicesDbTb2(IteSName,IteSSizeUnit,IteSCont,IteSPri,IteSTotContPri,IteSTask,IteSTotlAmnt) values ")
For i As Integer = 0 To SellingDGView.Rows.Count - 2
Sb.appendLine($"(#IteSName{i},#IteSSizeUnit{i},#IteSCont{i},#IteSPri{i},#IteSTotContPri{i},#IteSTask{i},#IteSTotlAmnt{i}){if(I=SellingDGView.Rows.Count - 2,"",",")}")
Dim unused = SaveCmd1.Parameters.AddWithValue($"#IteSName{i}", SellingDGView.Rows(i).Cells(0).Value.ToString())
Dim unused3 = SaveCmd1.Parameters.AddWithValue($"#IteSSizeUnit{i}", SellingDGView.Rows(i).Cells(1).Value.ToString())
Dim unused4 = SaveCmd1.Parameters.AddWithValue($"#IteSCont{i}", SellingDGView.Rows(i).Cells(2).Value.ToString())
Dim unused5 = SaveCmd1.Parameters.AddWithValue($"#IteSPri{i}", SellingDGView.Rows(i).Cells(3).Value.ToString())
Dim unused6 = SaveCmd1.Parameters.AddWithValue($"#IteSTotContPri{i}", SellingDGView.Rows(i).Cells(4).Value.ToString())
Dim unused7 = SaveCmd1.Parameters.AddWithValue($"#IteSTask{i}", SellingDGView.Rows(i).Cells(5).Value.ToString())
Dim unused8 = SaveCmd1.Parameters.AddWithValue($"#IteSTotlAmnt{i}", SellingDGView.Rows(i).Cells(6).Value.ToString())
Next
SaveCmd1.CommandText= sb.ToString
Another way to solve your problem is to do the insert inside the loop. While this will be slightly slower, in practice the difference is going to be irrelevant at your scale. If it was relevant, your entire process would need to be changed drastically.
For i As Integer = 0 To SellingDGView.Rows.Count - 2
Dim sb as new StringBuilder
Sb.appendLine("insert into InvoicesDbTb2(IteSName,IteSSizeUnit,IteSCont,IteSPri,IteSTotContPri,IteSTask,IteSTotlAmnt) values ")
Sb.appendLine($"(#IteSName{i},#IteSSizeUnit{i},#IteSCont{i},#IteSPri{i},#IteSTotContPri{i},#IteSTask{i},#IteSTotlAmnt{i})")
Using SaveCmd1 = Zsqlcon.CreateCommand(Sb.ToString)
Dim unused = SaveCmd1.Parameters.AddWithValue($"#IteSName{i}", SellingDGView.Rows(i).Cells(0).Value.ToString())
Dim unused3 = SaveCmd1.Parameters.AddWithValue($"#IteSSizeUnit{i}", SellingDGView.Rows(i).Cells(1).Value.ToString())
Dim unused4 = SaveCmd1.Parameters.AddWithValue($"#IteSCont{i}", SellingDGView.Rows(i).Cells(2).Value.ToString())
Dim unused5 = SaveCmd1.Parameters.AddWithValue($"#IteSPri{i}", SellingDGView.Rows(i).Cells(3).Value.ToString())
Dim unused6 = SaveCmd1.Parameters.AddWithValue($"#IteSTotContPri{i}", SellingDGView.Rows(i).Cells(4).Value.ToString())
Dim unused7 = SaveCmd1.Parameters.AddWithValue($"#IteSTask{i}", SellingDGView.Rows(i).Cells(5).Value.ToString())
Dim unused8 = SaveCmd1.Parameters.AddWithValue($"#IteSTotlAmnt{i}", SellingDGView.Rows(i).Cells(6).Value.ToString())
SaveCmd1.ExecuteNonQuery()
End Using
Next
Keep you connection and command local to the method where they are used. These database objects may be used unmanaged resources which need to be released. Normally this is done in their .Dispose method. A Using...End Using block handles this for you even if there is an error.
Add the parameters once outside the loop. I had to guess at the datatypes. Check your database for the actual types and adjust the code accordingly. You will also have to adjust the values of the parameters in the loop. See the CInt, CDec, .ToString etc..
Only the values of the parameters change in the loop. You are not creating and adding the parameters over and over.
Private Sub OPCode()
Using Zsqlcon As New SqlConnection("Your connection string"),
SaveCmd1 As New SqlCommand("insert into InvoicesDbTb2(IteSName,IteSSizeUnit,IteSCont,IteSPri,IteSTotContPri,IteSTask,IteSTotlAmnt) values
(#IteSName,#IteSSizeUnit,#IteSCont,#IteSPri,#IteSTotContPri,#IteSTask,#IteSTotlAmnt)", Zsqlcon)
With SaveCmd1.Parameters
.Add("#IteSName", SqlDbType.NVarChar, 100)
.Add("#IteSSizeUnit", SqlDbType.Int)
.Add("#IteSCont", SqlDbType.Int, 100)
.Add("#IteSPri", SqlDbType.Decimal)
.Add("#IteSTotContPri", SqlDbType.Decimal)
.Add("#IteSTask", SqlDbType.NVarChar, 100)
.Add("#IteSTotlAmnt", SqlDbType.Decimal)
End With
Zsqlcon.Open()
For i As Integer = 0 To SellingDGView.Rows.Count - 2
With SaveCmd1
.Parameters("#IteSName").Value = SellingDGView.Rows(i).Cells(0).Value.ToString()
.Parameters("#IteSSizeUnit").Value = CInt(SellingDGView.Rows(i).Cells(1).Value)
.Parameters("#IteSCont").Value = CInt(SellingDGView.Rows(i).Cells(2).Value)
.Parameters("#IteSPri").Value = CDec(SellingDGView.Rows(i).Cells(3).Value)
.Parameters("#IteSTotContPri").Value = CDec(SellingDGView.Rows(i).Cells(4).Value)
.Parameters("#IteSTask").Value = SellingDGView.Rows(i).Cells(5).Value.ToString()
.Parameters("#IteSTotlAmnt").Value = CDec(SellingDGView.Rows(i).Cells(6).Value)
End With
SaveCmd1.ExecuteNonQuery()
Next
End Using
End Sub

Retrieving all dxf values for all DBText

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

Add attribute to block: Autocad API VB.net

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?

finding the intersection point of a circle with a line in autocad customization using vb.net

For my autocad customization, I need to find the intersection point of a circle with a line. Below is my code but it does not return me any intersection point.
There will always be at least one intersection point because of constraints imposed on my problem. But, I really cant get that intersection point.Can someone help me show the way to achieving what I want to do?
Imports System
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.ApplicationServices.DocumentExtension
Namespace sweeping
Public Class intersecting
<CommandMethod("ITSSPS")>
Public Shared Sub SweepAlongPath()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using tr As Transaction = db.TransactionManager.StartTransaction()
'getting point1
Dim ppo1 As PromptPointOptions = New PromptPointOptions(vbLf & "choose/click the centre of the first circle:")
Dim ppr1 As PromptPointResult = doc.Editor.GetPoint(ppo1)
Dim pt1 As Point3d = ppr1.Value
If ppr1.Status = PromptStatus.Cancel Then Exit Sub
Dim pdo11 As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "The radius of the first cycle? Type 5 as 5.0")
Dim pdr11 As PromptDoubleResult = doc.Editor.GetDouble(pdo11)
Dim pd11 As Double = pdr11.Value
If pdr11.Status = PromptStatus.Cancel Then Exit Sub
Dim pdo12 As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "What about the height? Type 5 as 5.0")
Dim pdr12 As PromptDoubleResult = doc.Editor.GetDouble(pdo12)
Dim pd12 As Double = pdr12.Value
If pdr12.Status = PromptStatus.Cancel Then Exit Sub
'getting point2
Dim ppo2 As PromptPointOptions = New PromptPointOptions(vbLf & "choose/click the centre of the second circle:")
Dim ppr2 As PromptPointResult = doc.Editor.GetPoint(ppo2)
Dim pt2 As Point3d = ppr2.Value
If ppr2.Status = PromptStatus.Cancel Then Exit Sub
Dim pdo21 As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "The radius of the second cycle? Type 5 as 5.0")
Dim pdr21 As PromptDoubleResult = doc.Editor.GetDouble(pdo21)
Dim pd21 As Double = pdr21.Value
If pdr21.Status = PromptStatus.Cancel Then Exit Sub
Dim pdo22 As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "What about the height? Type 5 as 5.0")
Dim pdr22 As PromptDoubleResult = doc.Editor.GetDouble(pdo22)
Dim pd22 As Double = pdr22.Value
If pdr22.Status = PromptStatus.Cancel Then Exit Sub
Dim line12 As Line = New Line(pt1, pt2)
Dim Cir1, Cir2 As Circle
Cir1 = New Circle() : Cir1.Center = pt1 : Cir1.Normal = New Vector3d(0, 0, 1) : Cir1.Radius = pd11
Cir2 = New Circle() : Cir2.Center = pt2 : Cir2.Normal = New Vector3d(0, 0, 1) : Cir2.Radius = pd21
Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim Cir11 As Entity = DirectCast(Cir1, Entity)
Dim line121 As Entity = DirectCast(line12, Entity)
btr.AppendEntity(Cir11)
tr.AddNewlyCreatedDBObject(Cir11, True)
btr.AppendEntity(line121)
tr.AddNewlyCreatedDBObject(line121, True)
Dim its3dpts As Point3dCollection = New Point3dCollection()
line121.IntersectWith(Cir11, Intersect.OnBothOperands, its3dpts, IntPtr.Zero, IntPtr.Zero)
For Each pt3d As Point3d In its3dpts
Dim ptt As Point3d = pt3d
Dim Cir3 As Circle = New Circle()
Cir3.Center = ptt : Cir3.Normal = New Vector3d(0, 0, 1) : Cir3.Radius = 450
ed.WriteMessage(pt3d.ToString)
btr.AppendEntity(Cir3)
tr.AddNewlyCreatedDBObject(Cir3, True)
Next
tr.Commit()
End Using
End Sub
End Class
End Namespace
Thanks a million to whoever helps me.
This call to IntersectWith should work. I tried here and it's working fine. Are you sure the Circle and the Line really intersect?
Below is my testing code:
[CommandMethod("findIntersect")]
public static void CmdFindIntersect()
{
Editor ed = Application.DocumentManager.MdiActiveDocument.Editor;
ObjectId lineId = ed.GetEntity("Select line: ").ObjectId; // not safe, test only
ObjectId circleId = ed.GetEntity("Select circle: ").ObjectId; // not safe, test only
Database db = Application.DocumentManager.MdiActiveDocument.Database;
using (Transaction trans = db.TransactionManager.StartTransaction())
{
Line l = trans.GetObject(lineId, OpenMode.ForRead) as Line;
Circle c = trans.GetObject(circleId, OpenMode.ForRead) as Circle;
Point3dCollection intersectionPoints = new Point3dCollection();
l.IntersectWith(c, Intersect.OnBothOperands, intersectionPoints, IntPtr.Zero, IntPtr.Zero);
trans.Commit();
ed.WriteMessage("{0} intersection(s) found", intersectionPoints.Count);
}
}

why I can't set nothing to variable in vb.net?

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