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
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 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
Here is my function that allows me to get from a webpage the image link for my PictureBoxs and the title for my labels
Public Shared Function getPics(website As String, pattern As String)
Dim tempTitles As New List(Of String)()
Dim tempTitles2 As New List(Of String)()
Dim lestitres As New List(Of titlesclass)
Dim webClient As New WebClient()
webClient.Headers.Add("user-agent", "null")
Dim counter As Integer = 0
Dim counter2 As Integer = 0
Dim counter3 As Integer = 0
Dim counter4 As Integer = 1
Dim counter5 As Integer = 0
Dim counter6 As Integer = 0
'If the website happens to go offline, at least your application wont crash.
Dim content As String = webClient.DownloadString(website)
Dim query = From title In Regex.Matches(content, pattern).Cast(Of Match)
Select New With {Key .Link = String.Concat("http://www.gamestop.com", title.Groups("Data").Value),
Key .Title = title.Groups("Dataa").Value}
For Each letitre In query.Distinct
'MsgBox(letitre.Link & " ======= " & letitre.Title)
Next
'For Each title As Match In (New Regex(pattern).Matches(content)) 'Since you are only pulling a few strings, I thought a regex would be better.
' Dim letitre As New titlesclass
' letitre.Link = title.Groups("Data").Value
' letitre.Title = title.Groups("Dataa").Value
' lestitres.Add(letitre)
' 'tempTitles2.Add(title.Groups("Dataa").Value)
'Next
Dim titles = tempTitles.Distinct().ToArray() 'remove duplicate titles
'Dim titles2 = tempTitles2.Distinct().ToArray()
Dim titles2 = lestitres.Distinct().ToArray()
lestitres.Clear()
'For Each title As titlesclass In titles2
For Each letitre In query.Distinct
'ListBox.Items.Add(title) 'what you do with the values from here is up to you.
Dim ImageInBytes() As Byte = webClient.DownloadData(letitre.Link)
Dim ImageStream As New IO.MemoryStream(ImageInBytes)
Dim MyPic As New PictureBox
Dim MyLab As New Label
If (counter2 > 0 AndAlso ((counter2 Mod 4 = 0) OrElse counter3 = 1)) Then
counter3 = 1
counter4 += 1
If (counter2 Mod 4 = 0) Then
counter5 = 0
counter6 += 170
End If
MyPic.Location = New Point(counter5, MyPic.Location.Y + counter6)
MyLab.Location = New Point(counter5, MyPic.Location.Y + counter6)
If counter4 = 4 Then
counter3 = 0
End If
counter5 += 200
Else
MyPic.Location = New Point(counter, MyPic.Location.Y)
MyLab.Location = New Point(counter, MyPic.Location.Y)
End If
counter += 200
counter2 += 1
MyPic.SizeMode = PictureBoxSizeMode.AutoSize
MyLab.Text = letitre.Title
MyPic.Image = New System.Drawing.Bitmap(ImageStream)
Form2.Controls.Add(MyPic)
Form2.Controls.Add(MyLab)
Next
End Function
The class named titlesclass contain two elements which i will store my Link and Title in :
Public Class titlesclass
Public Property Link As String
Public Property Title As String
End Class
And My little button does all the work
Dim websiteURL1 As String = "http://www.gamestop.com/collection/upcoming-video-games"
Class1.getPics(websiteURL1, "<img src=""(?<Data>[^>]*)""><p>(?<Dataa>[^>]*)<br>")
What i'm trying to do is to show 4 pictureboxs per row with the lables right bellow each picture , for now some labels doesn't show , some shows just in the right place and some shows very far bellow ! I tested the values i'm getting with a Message Box and it shows me the informations in the order i need , i'm not sure if i screw up in the x,y values or if it's something else ...
Edit : I can already show the 4 pictureboxes per row , the labels also , but the Y of some labels isn't well adjusted it can go far far bellow !
Here is some pictures that will help you to understand my situation Don't mind the buttons and listboxs , it's just for the test :
My list containt a lot of pictures , so i just showed you some when the thing work kind of well , when it shows couple of rows far from the designed picture
http://img110.xooimage.com/files/f/a/d/picture1-5239f7c.png
http://img110.xooimage.com/files/8/f/8/picture-2-5239f7e.png
http://img110.xooimage.com/files/4/7/b/picture-3-5239f80.png
http://img110.xooimage.com/files/f/0/f/picture4-5239f82.png
So I cleaned the way you where generating the position of the PictureBox by using a row principle and increment:
Note:
If you need space at the top to add information start the row count at 1 instead of 0
Note 2:
Here the image dimensions are harcoded but you could use dynamic ones which would be more fluid. I just cleaned the positioning code not the rest.
Replace your function by this one:
Public Shared Sub getPics(website As String, pattern As String)
Dim tempTitles As New List(Of String)()
Dim tempTitles2 As New List(Of String)()
Dim lestitres As New List(Of titlesclass)
Dim webClient As New WebClient()
webClient.Headers.Add("user-agent", "null")
Dim counter As Integer = 0
Dim counter2 As Integer = 0
Dim counter3 As Integer = 0
Dim counter4 As Integer = 1
Dim counter5 As Integer = 0
Dim counter6 As Integer = 0
'If the website happens to go offline, at least your application wont crash.
'Handle default proxy
Dim proxy As IWebProxy = WebRequest.GetSystemWebProxy()
proxy.Credentials = CredentialCache.DefaultCredentials
webClient.Proxy = proxy
Dim content As String = webClient.DownloadString(website)
Dim query = From title In Regex.Matches(content, pattern).Cast(Of Match)
Select New With {Key .Link = String.Concat("http://www.gamestop.com", title.Groups("Data").Value),
Key .Title = title.Groups("Dataa").Value}
Dim titles = tempTitles.Distinct().ToArray() 'remove duplicate titles
Dim titles2 = lestitres.Distinct().ToArray()
lestitres.Clear()
'Count Items
Dim item As Integer = 0
'Count Row
Dim row As Integer = 0
'image: 222*122
For Each letitre In query.Distinct
Dim ImageInBytes() As Byte = webClient.DownloadData(letitre.Link)
Dim ImageStream As New IO.MemoryStream(ImageInBytes)
Dim MyPic As New PictureBox
Dim MyLab As New Label
'x = numéro item fois largeur image
'y = numéro de ligne fois hauteur image
MyPic.Location = New Point(item * 222, row * 122)
MyLab.Location = New Point(item * 222, row * 122)
MyPic.SizeMode = PictureBoxSizeMode.AutoSize
MyLab.Text = letitre.Title
MyPic.Image = New System.Drawing.Bitmap(ImageStream)
Form1.Controls.Add(MyPic)
Form1.Controls.Add(MyLab)
'Bring Labels to front
For Each ctrl As Control In Form1.Controls
'If the control is of type label
If TypeOf ctrl Is Label Then
'Then bring to front
ctrl.BringToFront()
End If
Next
'Increment the item count
item = item + 1
'If item is multiple of 4 or could check 4 then
If item Mod 4 = 0 Then
'Reset counter
item = 0
'Increment Row
row = row + 1
End If
Next
End Sub
Example return:
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?
Goal
To trim a line in an ellipse that goes to it's center. The portion of the line that enters the ellipse should be trimmed off.
This is the untrimmed ellipse
This is the trimmed ellipse, the goal of this question
Attempt
CreateConveyorNameEllipse(AcadDoc)
Public Function CreateConveyorNameEllipse(ByRef AcadDoc As Document) As ObjectId
Dim returnId As ObjectId
Dim db As Database = AcadDoc.Database
Dim x As Vector3d = db.Ucsxdir
Dim y As Vector3d = db.Ucsydir
Dim normalVec As Vector3d = x.CrossProduct(y)
Dim axisvec As Vector3d = normalVec.GetNormal()
Dim CenterPoint As New Point3d(Me.StartPoint.X + 50, Me.StartPoint.Y + 40, 0)
Dim aEllipse As Ellipse
aEllipse = New Ellipse(CenterPoint, axisvec, New Vector3d(30, 0, 0), 0.35, 0, Math.PI * 2)
aEllipse.SetDatabaseDefaults()
returnId = Utils.CreateAcadObject(AcadDoc, aEllipse)
aEllipse.Dispose()
Utils.regenLayers()
Return returnId
End Function
CreateConveyorEllipseLineConnection(AcadDoc)
Public Function CreateConveyorEllipseLineConnection(ByRef AcadDoc As Document) As ObjectId
Dim returnId As ObjectId
Dim CenterPoint As New Point3d(Me.StartPoint.X + 50, Me.StartPoint.Y + 40, 0)
Dim aLine As Line
aLine = New Line(Me.StartPoint, CenterPoint)
aLine.SetDatabaseDefaults()
returnId = Utils.CreateAcadObject(AcadDoc, aLine)
aLine.Dispose()
Utils.regenLayers()
Return returnId
End Function
CreateAcadObject(AcadDoc, AcadObj)
Public Function CreateAcadObject(ByRef acDoc As Document, ByRef acObj As Object) As ObjectId
Dim objId As ObjectId
Dim acCurDb As Database = acDoc.Database 'Get the current database
Dim acBlkTbl As BlockTable
Dim acBlkTblRec As BlockTableRecord
Using lock As DocumentLock = acDoc.LockDocument
'Start a transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'Open Model space for write
acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
acObj.SetDatabaseDefaults()
'Add the object to the drawing
objId = acBlkTblRec.AppendEntity(acObj)
acTrans.AddNewlyCreatedDBObject(acObj, True)
'Commit the changes and dispose of the transaction
acTrans.Commit()
End Using
End Using
Return objId
End Function
I'm not quite sure how to apply the trim to the line. I've seen some IntersectWith methods but couldn't get it to work yet. I'll be working on this meanwhile and if I find the answer I'll be sure to post it here.
You can take advantage of a few cool methods dealing with curves to handle this:
Private Shared Function TrimmedLine(line As Line, ent As Entity) As Line
If line Is Nothing Then
Throw New ArgumentNullException("line")
End If
' Original line is returned since there's nothing to break it
If ent Is Nothing Then Return line
Dim extPoints = New Point3dCollection()
Try
line.IntersectWith(ent, Intersect.ExtendArgument, extPoints, IntPtr.Zero, IntPtr.Zero)
' Original line gets returned since it doesn't intersect
If extPoints.Count = 0 Then Return line
Dim splitLines = line.GetSplitCurves(extPoints)
' Not sure when this would fail, investigate.
If splitLines.Count = 0 Then Return Nothing
' Return the outer line in this case
Return DirectCast(splitLines(0), Line)
Catch ex As Autodesk.AutoCAD.Runtime.Exception
System.Diagnostics.Debug.Write(ex.Message)
Throw
End Try
End Function