Hey guys I have an example here, but I am not sure what to do next. I am trying to check all lines in a drawing and if Z <> 0 then I would like to move or change the Z to 0.0 In this modified example I just created a new line and I dont want a double line........I guess my other option would be to delete the original line, but not sure how to do that either.
Thanks in advance.
Option Strict On
Imports System.IO
Imports System.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime
Public Class Class1
<CommandMethod("ml")> _
Public Sub FilterSelectionSet()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
' We only want to select lines...
' Use an options object to specify how the
' selection occurs (in terms of prompts)
' http://through-the-interface.typepad.com/through_the_interface/2010/02/extending-a-set-of-autocad-lines-using-net.html
Dim pso As New PromptSelectionOptions()
pso.MessageForAdding = vbLf & "Select lines: "
' Use a filter to specify the objects that
' get included in the selection set
Dim tvs As TypedValue() = New TypedValue(0) {New TypedValue(CInt(DxfCode.Start), "LINE")}
Dim sf As New SelectionFilter(tvs)
' Perform our restricted selection
Dim psr As PromptSelectionResult = ed.GetSelection(pso, sf)
If psr.Status <> PromptStatus.OK Then
Return
End If
' Assuming something was selected...
If psr.Value.Count > 0 Then
' Start our transaction
Dim tr As Transaction = db.TransactionManager.StartTransaction()
Using tr
Application.SetSystemVariable("CECOLOR", "251")
'' Open the Layer table for read
Dim acLyrTbl As LayerTable
acLyrTbl = CType(tr.GetObject(db.LayerTableId, OpenMode.ForRead), LayerTable)
Dim sLayerName As String = "110"
If acLyrTbl.Has(sLayerName) = True Then
' Set the layer Center current
db.Clayer = acLyrTbl(sLayerName)
End If
Dim Found As Boolean = False
Dim i As Integer = 1
' variables to create circle
Dim mMid(2) As Double, St As Object, En As Object
Dim Pts As Object, Pt(2) As Double
' Open the Block table for read
Dim acBlkTbl As BlockTable
acBlkTbl = CType(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
' Open the Block table record Model space for write
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = CType(tr.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
' Edit each of the selected lines
For Each so As SelectedObject In psr.Value
' We're assuming only lines are in the selection-set
' Could also use a more defensive approach and
' use a dynamic cast (Line ln = xxx as Line;)
'Try
Dim ln As Line = DirectCast(tr.GetObject(so.ObjectId, OpenMode.ForWrite), Line)
Dim xs, ys, xe, ye As Double
xs = ln.StartPoint.X
ys = ln.StartPoint.Y
xe = ln.EndPoint.X
ye = ln.EndPoint.Y
'ln = New Line(New Point3d(xs, ys, 0), New Point3d(xe, ye, 0))
ln.ColorIndex = 1
'' Add the new object to the block table record and the transaction
acBlkTblRec.AppendEntity(ln)
tr.AddNewlyCreatedDBObject(ln, True)
Next
' Mustn't forget to commit
tr.Commit()
If Found = False Then
'MsgBox("No Undersized Lines Found")
ed.WriteMessage("No Undersized Lines Found")
Else
ed.WriteMessage(i & " Undersized Lines Were Found")
End If
End Using
End If
End Sub
End Class
