指向相交点VB。网
大家好，Autocad专家，我不熟悉使用VB进行Autocad自定义。网
我们需要从给定坐标到与任何其他线相交的点绘制一条水平线。这可能已经在论坛上讨论过了，但因为我是vb新手。net，我不能把东西放在一起。
感谢您对我的帮助。期待回复。 欢迎来到CADTutor。
也许你可以分享一下你的环境，以及可能帮助我们帮助你的专业知识？
你在开发什么版本，你在使用什么IDE，你在使用什么。NET向导或自定义模板，你如何分发你的应用程序，只是几个问题。
此外，请张贴您的代码。。。它不一定要有效，甚至不一定写得很好；这只是表明你已经投入了最初的努力，并且避免了另一个人从头开始编写代码（这节省了我们帮助你的时间）。
干杯 一些有帮助的理论，选取点，输入方向角，选取点作为搜索限制，使用这条“新”线，你可以得到所有相交对象，计算每个对象的交点，并进行比较，从而得到最近的点或最长的点。就像黑盒子邮政编码。 黑盒/二进制：
我正在开发的版本是Autocad 2012。我使用的IDE是Visual Studio 2012。我现在打算使用命令执行方法。我从这个论坛上截取了一些代码片段，并做了一些小改动，看看它是如何工作的。下面是代码：这比我实际需要的做了更多的事情。我的要求很简单。用户将提供坐标2。应（仅）从给定坐标绘制一条水平线，直到该水平线与另一条线或对象相交。我对此很陌生，因此需要你的支持来解决这个问题。谢谢
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
请阅读代码发布指南并编辑您的帖子，将代码包含在代码标签中。
页:
[1]