[编程交流] 指向相交点VB。网

Imports System.Collections.Generic
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Interop
Imports System.Text.RegularExpressions
Public Class Class1
   <CommandMethod("pts")> _
   Public Sub pts()
       Dim lineCmd As Editor = 
Application.DocumentManager.MdiActiveDocument.Editor
       Dim acadBaza As Database = lineCmd.Document.Database
       Dim trans As Transaction = 
acadBaza.TransactionManager.StartTransaction
       Dim opPoint As PromptPointOptions = New PromptPointOptions("Click on 
a Co-ordinate :")
       Dim rePoint As PromptPointResult = lineCmd.GetPoint(opPoint)
       Dim crvDict As Dictionary(Of Double, Line) = New Dictionary(Of 
Double, Line)()
       ' confstruction of filter
       Dim typeValue() As TypedValue = {New TypedValue(0, "line")}
       Dim selFilter As SelectionFilter = New SelectionFilter(typeValue)
       Dim selectResult As PromptSelectionResult = 
lineCmd.SelectAll(selFilter)
       If rePoint.Status = PromptStatus.OK Then
           Dim rePoint2 As Point3d = New Point3d(rePoint.Value.X + 10, 
rePoint.Value.Y, 0)
           Dim prosta As Ray = New Ray()
           Dim tmpPt As Point3d
           prosta.BasePoint = rePoint.Value
           prosta.SecondPoint = rePoint2
           Try
               Dim btr As BlockTableRecord = 
trans.GetObject(acadBaza.CurrentSpaceId, OpenMode.ForWrite)
               btr.AppendEntity(prosta)
               trans.AddNewlyCreatedDBObject(prosta, True)
               If selectResult.Status = PromptStatus.OK Then
                   Dim ss As SelectionSet = selectResult.Value
                   Dim idTab() As ObjectId = ss.GetObjectIds()
                   Dim ra As Ray = CType(trans.GetObject(prosta.Id, 
OpenMode.ForRead), Ray)
                   Dim ptc As Point3dCollection = New 
Point3dCollection()
                   Dim intthis As Integer
                   Dim intThat As Integer
                   Dim objId As ObjectId
                   Dim x As Double
                   For Each objId In idTab
                       Dim tempptc As Point3dCollection = New 
Point3dCollection()
                       Dim ln As Line = CType(trans.GetObject(objId, 
OpenMode.ForRead), Line)
                       ln.IntersectWith(ra, Intersect.OnBothOperands, 
ln.GetPlane(), tempptc, intthis, intThat)
                       If tempptc.Count > 0 Then
                           MsgBox(tempptc.Count)
                           For Each pt As Point3d In tempptc
                               x = Math.Round(pt.X, 6)
                               crvDict.Add(x, ln) 'add line to dictionary 
with X coordinate as Key
                               ptc.Add(pt)
                           Next
                       End If
                   Next
                   'trans.Commit()
                   If crvDict.Count > 0 Then
                       Dim pts As Point3d
                       tmpPt = ptc.Item(0)
                       Dim i As Integer
                       If ptc.Count > 1 Then
                           For i = 0 To ptc.Count - 1
                               pts = ptc(i)
                               If pts.X < tmpPt.X Then
                                   tmpPt = pts
                               End If
                           Next
                       End If
                       MsgBox(tmpPt.ToString)
                       Dim s As String() = Regex.Split(tmpPt.ToString, 
",")
                       Dim value1 As Double
                       Dim value2 As Double
                       Double.TryParse(s(0).Substring(1), value1)
                       Double.TryParse(s(1), value2)
                       Dim rePoint3 As Point3d = New Point3d(value1, value2, 
0)
                       Dim prosta1 As Line = New Line()
                       prosta1.StartPoint = rePoint.Value
                       prosta1.EndPoint = rePoint3
                       btr.AppendEntity(prosta1)
                       trans.AddNewlyCreatedDBObject(prosta1, True)
                       MsgBox(value1)
                       MsgBox(value2)
                       trans.Commit()
                       lineCmd.WriteMessage(tmpPt.ToString)
                       crvDict(Math.Round(tmpPt.X, 6)).Highlight() 'Retrieve 
line based on X coordinate Key equal to tmpPt.X
                       lineCmd.WriteMessage(" ObjectId: " & 
crvDict(Math.Round(tmpPt.X, 6)).ObjectId.ToString())
                   Else
                       lineCmd.WriteMessage("No intersections")
                   End If
               End If
           Catch ex As Exception
               lineCmd.WriteMessage("There is a problem" + ex.Message)
               MsgBox(ex.Message)
           Finally
               trans.Dispose()
           End Try
       End If
   End Sub
End Class

Imports System.Collections.Generic
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Interop
Public Class Class1
   <CommandMethod("dwl")> _
   Public Sub pts()
       Dim lineCmd As Editor = 
Application.DocumentManager.MdiActiveDocument.Editor
       Dim acadBaza As Database = lineCmd.Document.Database
       Dim opPoint As PromptPointOptions = New PromptPointOptions("Click on 
a Co-ordinate :")
       Dim rePoint As PromptPointResult = lineCmd.GetPoint(opPoint)
       Dim typeValue() As TypedValue = {New TypedValue(0, "line")}
       Dim selFilter As SelectionFilter = New SelectionFilter(typeValue)
       Dim selectResult As PromptSelectionResult = 
lineCmd.SelectAll(selFilter)
       If rePoint.Status = PromptStatus.OK Then
           Using trans As Transaction = 
acadBaza.TransactionManager.StartTransaction()
               Try
                   Dim prosta As Line = New Line(New 
Point3d(rePoint.Value.X, rePoint.Value.Y, 0), New Point3d(rePoint.Value.X * 100, 
rePoint.Value.Y, 0))
                   prosta.SetDatabaseDefaults()
                   Dim btr As BlockTableRecord = 
trans.GetObject(acadBaza.CurrentSpaceId, OpenMode.ForWrite)
                   btr.AppendEntity(prosta)
                   trans.AddNewlyCreatedDBObject(prosta, True)
                   Dim ra As Line = CType(trans.GetObject(prosta.Id, 
OpenMode.ForWrite), Line)
                   If selectResult.Status = PromptStatus.OK Then
                       Dim ss As SelectionSet = selectResult.Value
                       Dim idTab() As ObjectId = ss.GetObjectIds()
                       Dim objId As ObjectId
                       Dim x As Double
                       Dim dl As Boolean = True
                       For Each objId In idTab
                           Dim tempptc As Point3dCollection = New 
Point3dCollection()
                           Dim ln As Line = CType(trans.GetObject(objId, 
OpenMode.ForRead), Line)
                           ln.IntersectWith(ra, Intersect.OnBothOperands, 
ln.GetPlane(), tempptc, 0, 0)
                           If tempptc.Count > 0 And dl Then
                               For Each pt As Point3d In tempptc
                                   x = Math.Round(pt.X, 6)
                                   MsgBox("Second point" & x.ToString 
& ":", MsgBoxStyle.Information)
                                   Dim prosta2 As Line = New Line(New 
Point3d(rePoint.Value.X, rePoint.Value.Y, 0), New Point3d(x, rePoint.Value.Y, 
0))
                                   btr.AppendEntity(prosta2)
                                   trans.AddNewlyCreatedDBObject(prosta2, 
True)
                                   dl = False
                                   Exit For
                               Next
                           End If
                       Next
                   End If
                   ra.Erase(True)
                   trans.Commit()
               Catch ex As Exception
                   lineCmd.WriteMessage("Error:" + ex.Message)
                   MsgBox(ex.Message)
               Finally
                   trans.Dispose()
               End Try
           End Using
       End If
   End Sub
End Class