社区 › Auto Lisp › 跟踪线。网

PanHasan 发表于 2022-7-6 12:46:23

跟踪线。网

你好
我写了一些代码，但它只在某些时候起作用，我不明白为什么代码假设使用光线和一小行来跟踪一行（如果有必要，我可以用我的概念画一些文件）。当我画两行类似“/”的东西时，问题很奇怪，我启动了光线“->/”它有时起作用，如果有人能带着批评的眼光看代码，有时会画一些愚蠢的东西

   <CommandMethod("src")> _
      Public Sub src()
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Using trn As Transaction = acBaza.TransactionManager.StartTransaction

         Dim usrPtOp As PromptPointOptions = New PromptPointOptions("Wskarz srodek pomieszczenia" + vbCrLf)
         Dim usrPt As PromptPointResult = lCmd.GetPoint(usrPtOp)

         Dim prevPt As Point3d = usrPt.Value
         Dim nextPt As Point3d = usrPt.Value

         If usrPt.Status = PromptStatus.OK Then ' sprawdzenie czy poprawnie wpisano punkt poczatkowy
               Dim usrPtXmod As Point3d = New Point3d(usrPt.Value.X + 1, usrPt.Value.Y, usrPt.Value.Z)
               Dim ls3d As LineSegment3d = New LineSegment3d(usrPt.Value, usrPtXmod)

               'FILTRACJA LINII
               Dim typeValue() As TypedValue = {New TypedValue(0, "line")}
               Dim selFilter As SelectionFilter = New SelectionFilter(typeValue)
               Dim selResult As PromptSelectionResult = lCmd.SelectAll(selFilter)
               Dim ssLinie As SelectionSet = selResult.Value
               Dim tabId() As ObjectId
               If selResult.Status = PromptStatus.OK Then ' sprawdzenie czy w rysunku znajduja sie jakies linie
                   If ssLinie.Count >= 1 Then
                     tabId = ssLinie.GetObjectIds

                     Dim oid As ObjectId
                     Dim tmpPt2 As Point3d
                     Dim przeciecia As Integer

                     Dim lnL1 As Line = New Line()
                     Dim promienSledzacy As Ray = New Ray()
                     Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                     'dodanie do rysunku lnL1 i promienia sledzacego bez parametrow jeszcze niewidoczne
                     btr.AppendEntity(lnL1)
                     trn.AddNewlyCreatedDBObject(lnL1, True)
                     btr.AppendEntity(promienSledzacy)
                     trn.AddNewlyCreatedDBObject(promienSledzacy, True)
                     ' rysowanie pierwszego promienia sledzacego
                     oid = przecieciaPromienia(promienSledzacy, ls3d, tabId, prevPt, nextPt)
                     Dim lnNajblizsza As Line = CType(trn.GetObject(oid, OpenMode.ForRead), Line)

                     'Sprawdzenie ktory punkt jest nizej
                     Dim START As Point3d
                     Dim FIN As Point3d
                     Dim PunktyPomieszczenia As Point3dCollection = New Point3dCollection()
                     If lnNajblizsza.StartPoint.Y > lnNajblizsza.EndPoint.Y Then
                           START = lnNajblizsza.EndPoint
                           PunktyPomieszczenia.Add(lnNajblizsza.EndPoint)
                           PunktyPomieszczenia.Add(lnNajblizsza.StartPoint)
                     Else
                           START = lnNajblizsza.StartPoint
                           PunktyPomieszczenia.Add(lnNajblizsza.StartPoint)
                           PunktyPomieszczenia.Add(lnNajblizsza.EndPoint)
                     End If
                     Dim IloscWszystkichLinii As Integer = tabId.Count()
                     Dim licznik As Integer = 0
                     Dim bezpiecznik As Integer = 0
                     While (licznik < IloscWszystkichLinii) And (bezpiecznik < IloscWszystkichLinii * 6)
                           rysujOdPomocniczy(prevPt, nextPt, tmpPt2, lnL1)
                           szukajPrzecieciaPomocniczego(przeciecia, prevPt, nextPt, tmpPt2, tabId, lnL1)
                           If przeciecia = 0 Then
                               prevPt = tmpPt2
                           ElseIf przeciecia = 1 Then
                               licznik = licznik + 1
                               ls3d = New LineSegment3d(nextPt, prevPt)
                               Using trn1 As Transaction = acBaza.TransactionManager.StartTransaction
                                 Try
                                       Dim btr1 As BlockTableRecord = trn1.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
                                       Dim ll As Line = CType(trn1.GetObject(lnNajblizsza.ObjectId, OpenMode.ForWrite), Line)
                                       ll.Erase()
                                       trn1.Commit()
                                 Catch ex As Exception
                                       lCmd.WriteMessage("Wyjatek w usowanie linii" + vbCrLf)
                                 Finally
                                       trn1.Dispose()
                                 End Try
                               End Using
                               'aktualizacja lini z rysunku
                               selResult = (lCmd.SelectAll(selFilter))
                               ssLinie = selResult.Value
                               tabId = ssLinie.GetObjectIds
                               'rysowanie promieni
                               oid = przecieciaPromienia(promienSledzacy, ls3d, tabId, prevPt, nextPt)
                               przeciecia = 0
                               lnNajblizsza = CType(trn.GetObject(oid, OpenMode.ForRead), Line)
                           Else
                               lCmd.WriteMessage("WIECEJ NIZ JEDNO PRZECIECIE" + vbCrLf)
                           End If
                           bezpiecznik = bezpiecznik + 1
                     End While
                     If bezpiecznik = IloscWszystkichLinii * 4 Then
                           lCmd.WriteMessage("Linia nie zakonczona")
                     End If
                   Else
                     lCmd.WriteMessage("ERROR : Mniej niz 3 linie pomieszczenie nie moze byc domkniete")
                   End If
               Else
                   lCmd.WriteMessage("ERROR : Brak linii w rysunku")
               End If
               trn.Commit()
         End If
       End Using

   End Sub
   ' RYSUJE PROMIEN SLEDZACY
   ' DRAW A TRACING RAY
   ' SZUKA LINII NAJBLIZSZEJ DANEMU PUNKTOWI
   ' SEARCH FOR THE NEAREST LINE FOR THE POINT
   Public Function przecieciaPromienia(ByRef promienSledzacy As Ray, ByRef ls3d As LineSegment3d, ByRef tabID() As ObjectId, ByRef prevPt As Point3d, ByRef nextPt As Point3d) As ObjectId
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = Application.DocumentManager.MdiActiveDocument.Database
       Dim lnNajblizsza As Line = Nothing
       Using trn As Transaction = acBaza.TransactionManager.StartTransaction
         Try
               Dim btr As BlockTableRecord = CType(trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
               Dim objID As ObjectId
               Dim ra3d As Ray3d = New Ray3d(ls3d.StartPoint, ls3d.EndPoint)

               Dim odl As Single = 0.0
               Dim odlTmp As Single = 0.0
               For Each objID In tabID
                   Dim ln As Line = CType(trn.GetObject(objID, OpenMode.ForRead), Line)
                   Dim ls As LineSegment3d = New LineSegment3d(ln.StartPoint, ln.EndPoint)
                   Dim ptArray() As Point3d = ls.IntersectWith(ra3d)
                   If ptArray Is Nothing Then Continue For
                   Dim ptkPrzeciecia As Point3dCollection = New Point3dCollection(ptArray)
                   'SZUKANIE PIERWSZEJ NAJBLIZSZEJ LINII   
                   '   odl=sqrt ((x1-x2)*(x1-x2) + (y1-y2)*(y1-y2))
                   odlTmp = Math.Sqrt((prevPt.X - ptkPrzeciecia.Item(0).X) * (prevPt.X - ptkPrzeciecia.Item(0).X) + (prevPt.Y - ptkPrzeciecia.Item(0).Y) * (prevPt.Y - ptkPrzeciecia.Item(0).Y))
                   If odl = 0.0 Then
                     odl = odlTmp
                     nextPt = ptkPrzeciecia.Item(0)
                     lCmd.WriteMessage("Prze:" + nextPt.ToString + "il :" + ptkPrzeciecia.Count.ToString)
                     lnNajblizsza = ln
                   ElseIf odl >= odlTmp Then
                     nextPt = ptkPrzeciecia.Item(0)
                     lCmd.WriteMessage("Prze:" + nextPt.ToString + "il :" + ptkPrzeciecia.Count.ToString)
                     lnNajblizsza = ln
                   End If
               Next
               promienSledzacy = CType(trn.GetObject(promienSledzacy.ObjectId, OpenMode.ForWrite), Ray)
               promienSledzacy.BasePoint = ls3d.StartPoint
               promienSledzacy.SecondPoint = ls3d.EndPoint
               trn.Commit()
         Catch ex As Exception
               lCmd.WriteMessage("Wyjatek w przecieciaPromienia" + ex.ToString + vbCrLf)
         End Try
         Return lnNajblizsza.ObjectId
       End Using
   End Function
   'RYSUJE MALE ODCINKI POMOCNICZE
   'DRAW A LITTLES HELP LINES
   Public Sub rysujOdPomocniczy(ByRef prevPt As Point3d, ByRef nextPt As Point3d, ByRef tmpPt2 As Point3d, ByRef lnL1 As Line)
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Dim trn As Transaction = acBaza.TransactionManager.StartTransaction
       Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
       Dim tmpPt1 As Point3d = prevPt
       tmpPt2 = nextPt
       ' WYZNACZANIE KATOW KTORE TRZEBA SPRAWDZIC NA PODSTWAIE POPRZEDNIEGO PUNKTU
       Try
         lnL1 = CType(trn.GetObject(lnL1.ObjectId, OpenMode.ForWrite), Line)
         'Wariant I
         If Math.Round(prevPt.X) = Math.Round(nextPt.X) Then
               If nextPt.Y > prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X - 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X + 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant II
         ElseIf Math.Round(prevPt.Y) = Math.Round(nextPt.Y) Then
               If nextPt.X > prevPt.X Then
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y + 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y - 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant III
         ElseIf Math.Round(prevPt.X) < Math.Round(nextPt.X) Then
               If nextPt.Y > prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X - 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y + 10, 0) ' poprawiono
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
               'Wariant IV
         ElseIf Math.Round(prevPt.X) > Math.Round(nextPt.X) Then
               If nextPt.Y < prevPt.Y Then
                   tmpPt2 = New Point3d(nextPt.X + 10, nextPt.Y, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               Else
                   tmpPt2 = New Point3d(nextPt.X, nextPt.Y - 10, 0)
                   lnL1.StartPoint = tmpPt1
                   lnL1.EndPoint = tmpPt2
               End If
         End If
         ' lCmd.WriteMessage(lnL1.StartPoint.ToString + "-" + lnL1.EndPoint.ToString + vbCrLf)
         trn.Commit()
       Catch ex As Exception
         lCmd.WriteMessage("Wyjatek w rysujOdPomocniczy" + vbCrLf)
       Finally
         trn.Dispose()
       End Try
   End Sub
   ' SEARCHES THE INTERS OF THE LITTLE HELP LINE
   Public Sub szukajPrzecieciaPomocniczego(ByRef przeciecia As Integer, ByRef prevPt As Point3d, ByRef nextPt As Point3d, ByRef tmpPt2 As Point3d, ByRef tabID() As ObjectId, ByRef lnL1 As Line)
       Dim lCmd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
       Dim acBaza As Database = lCmd.Document.Database
       Dim trn As Transaction = acBaza.TransactionManager.StartTransaction
       Dim Cl_crsPt As Point3dCollection = New Point3dCollection()
       Dim intPomoc1 As Integer
       Dim intPomoc2 As Integer
       Try
         Dim btr As BlockTableRecord = trn.GetObject(acBaza.CurrentSpaceId, OpenMode.ForWrite)
         Dim obj As ObjectId
         For Each obj In tabID
               Dim ln As Line = CType(trn.GetObject(obj, OpenMode.ForRead), Line)
               ln.IntersectWith(lnL1, Intersect.OnBothOperands, lnL1.GetPlane(), Cl_crsPt, intPomoc1, intPomoc2)
         Next
         przeciecia = Cl_crsPt.Count
         If Cl_crsPt.Count = 1 Then
               prevPt = Cl_crsPt.Item(0)
         ElseIf Cl_crsPt.Count > 1 Then
               lCmd.WriteMessage("Wiecej niz jedno przeciecie:" + Cl_crsPt.Count.ToString)
               Dim tmpPunkt As Point3d
               Dim odlPtkTmp As Single
               Dim odlPtk As Single
               For Each tmpPunkt In Cl_crsPt
                   odlPtkTmp = Math.Sqrt((prevPt.X - Cl_crsPt.Item(0).X) * (prevPt.X - Cl_crsPt.Item(0).X) + (prevPt.Y - Cl_crsPt.Item(0).Y) * (prevPt.Y - Cl_crsPt.Item(0).Y))
                   If odlPtk = 0.0 Then
                     odlPtk = odlPtkTmp
                     nextPt = Cl_crsPt.Item(0)
                   ElseIf odlPtk >= odlPtkTmp Then
                     nextPt = Cl_crsPt.Item(0)
                   End If
                   przeciecia = 1
               Next
         End If
         trn.Commit()
       Catch ex As Exception
         lCmd.WriteMessage("Wyjatek w szukajPrzecieciaPomocniczego" + vbCrLf)
       Finally
         trn.Dispose()
       End Try
   End Sub

SEANT 发表于 2022-7-6 12:51:27

我认为发布一个显示例程设计要处理的设置的图形，以及例程成功运行后应该显示的相同设置，会很有帮助。这将帮助我们提供有用的调试建议，特别是考虑到我们中的一些人不理解许多变量名或注释。
 
我想例程失败的示例文件（如果它实际上以一致的方式失败）也将有助于调试。

PanHasan 发表于 2022-7-6 12:56:59

你好
我已经添加了一些英文注释，但如果仍然不清楚，我会在您需要的地方添加
我的概念
http://www.image-share.com/image.php?img=45/191.pnghttp://www.image-share.com/image.php?img=45/191.pnghttp://www.image-share.com/upload/45/191.png
 
用法
http://www.image-share.com/image.php?img=45/192.pnghttp://www.image-share.com/upload/45/192.png
 
http://www.image-share.com/image.php?img=45/192.png

SEANT 发表于 2022-7-6 13:01:03

我不确定我是否完全理解这个过程，但请给我一些时间（我在正常日常活动的休息期间会看这个）。
 
我遇到的一个早期问题是，Visual Studio将此行标记为错误：
Dim IloscWszystkichLinii作为整数=tabId。计数（）
 
这是另一个导入的命名空间的一部分吗？我可以用其中一种吗
 
Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0)
 
或
 
Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0) + 1

SEANT 发表于 2022-7-6 13:06:22

作为可能帮助我们理解过程的另一点输入，真实世界中的几何建模是什么？
 
一、 就个人而言，无法确定这是土木工程的某个方面，还是机械问题。它是电气/电子的吗？这似乎与建筑无关，但我不能肯定地说。

PanHasan 发表于 2022-7-6 13:07:01

你好
嗯，这句话对我来说很好a不要出错
它假设得到图形中有多少条线
Dim IloscWszystkichLinii作为整数=tabId。计数（）
 
我的想法是，当我有一个2d房子的蓝图，有很多房间的时候，我用我的宏，点击一个房间里面，如果它能返回我这个房间的所有墙壁，那就太好了。我不知道我是否正确地解释了它

PanHasan 发表于 2022-7-6 13:12:28

我认为问题在于跟踪光线有时它根本无法与下一行交互，但为什么有时可以，有时不行我不知道
重要的一点是，这个宏将以相反的时钟方向搜索墙壁

SEANT 发表于 2022-7-6 13:14:32

啊，这是一个基于架构的例程。这很酷–它将帮助我理解参数。不幸的是，我将有很多工作要做，所以我要到今晚才能深入研究。
 
关于。计数问题，Visual Studio向我显示附件。你在使用什么进口产品？

PanHasan 发表于 2022-7-6 13:20:56

我来自地球的另一个角落，所以今晚很好
 
导入Autodesk。AutoCAD。运行时
导入Autodesk。AutoCAD。几何学
导入Autodesk。AutoCAD。应用程序服务
导入Autodesk。AutoCAD。编辑输入
导入Autodesk。AutoCAD。数据库服务
导入系统。窗户
导入系统。收藏。通用的
 
我正在使用vs2008

SEANT 发表于 2022-7-6 13:23:07

这很奇怪。我已经包括了与上面发布的相同的导入列表，并且这行仍然报告了一个错误（我也在使用Visual Studio 2008-Standard edition）。尽管这种情况可能很有趣，但我现在将忽略它，并使用最好的替代方案来运行该程序。
 
我假设我在上面发布的建议：
 
Dim IloscWszystkichLinii As Integer = tabId.GetUpperBound(0) + 1
 
应该有效。或者，也许：
 
Dim IloscWszystkichLinii As Integer = ssLinie.Count
 
我认为他们两个都会得到与你得到的相同的整数
 
Dim IloscWszystkichLinii As Integer = tabId.Count()
 
如果你有机会，试试看我的假设是否正确。谢谢

查看完整版本: 跟踪线。网