社区 › Auto Lisp › 交叉线列表

ursan 发表于 2022-7-6 21:49:23

交叉线列表

你好
 
我知道ı能够通过这个命令“object1.IntersectWith（IntersectObjects，ExtendOption）”找到两条线相交的点
 
 
将主线变暗为AcadLine
将line1、line2、line3标注为AcadLine
 
我有主线信息。ı想要找到与主线相交的其他线。
 
例如，line1、line2和line3与主线相交，ı想要找到这些线。
 
 

ronjonp 发表于 2022-7-6 21:56:01

这里有一个简单的例子：
(vl-load-com)
(defun c:foo (/ e)
(and (setq e (car (entsel "\Pick your line: ")))
      (= "LINE" (cdr (assoc 0 (entget e))))
      (sssetfirst
nil
(ssget "_F" (list (vlax-curve-getstartpoint e) (vlax-curve-getendpoint e)) '((0 . "line")))
      )
)
(princ)
)

maratovich 发表于 2022-7-6 21:59:18

样品
Public Sub TEST_SelectByIntersection()
Dim objSS As AcadSelectionSet
Dim objToCheck As AcadEntity
Dim varPnt As Variant
Dim objThatIntersects As AcadEntity
ThisDrawing.Utility.GetEntity objToCheck, varPnt, "Select an object: "
Set objSS = SelectByIntersection(objToCheck)
For Each objThatIntersects In objSS
   objThatIntersects.Highlight True
Next
If MsgBox("Object " & CStr(objSS.Count) & _
         " Object." & vbCrLf & "Delete?", _
         vbQuestion + vbYesNo, "TEST_SelectByIntersection") = vbYes Then
   For Each objThatIntersects In objSS
   objThatIntersects.Delete
   Next
Else
   For Each objThatIntersects In objSS
       objThatIntersects.Highlight False
   Next
End If
End Sub

Public Function SelectByIntersection(objEnt As AcadEntity) As AcadSelectionSet

On Error Resume Next
Dim objGen As AcadEntity
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim objArray() As Object
Dim strName As String
Dim varMin As Variant
Dim varMax As Variant
Dim varIntPnt As Variant
Dim intcnt As Integer

objEnt.GetBoundingBox varMin, varMax
strName = "vbdintersect"
Set objSelCol = ThisDrawing.SelectionSets
   For Each objSelSet In objSelCol
   If objSelSet.Name = strName Then
       ThisDrawing.SelectionSets.Item(strName).Delete
       Exit For
   End If
   Next
Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
objSelSet.Select acSelectionSetCrossing, varMin, varMax
For Each objGen In objSelSet
   varIntPnt = objEnt.IntersectWith(objGen, acExtendNone)
   
   MsgBox "1 intersection point dedected." & vbCr & _
   "X= " & varIntPnt(0) & ", " & "Y= " & varIntPnt(1) & vbCr, _
   vbInformation, "Intersection Point Dedector"
   
   
   If UBound(varIntPnt) = -1 Then
   ReDim Preserve objArray(intcnt)
   Set objArray(intcnt) = objGen
   intcnt = intcnt + 1
   End If
   varIntPnt = Empty
Next
If IsEmpty(objArray) Then
   Set SelectByIntersection = objSelSet
Else
   objSelSet.RemoveItems objArray
   Set SelectByIntersection = objSelSet
End If
Exit_Here:
Exit Function
MsgBox Err.Description
Resume Exit_Here
End Function

ursan 发表于 2022-7-6 22:04:47

这段代码运行得很好。但我不懂autolisp。如何在vb中编写此代码。net/vba或C#。网

ursan 发表于 2022-7-6 22:07:59

 
这段代码运行得很好。但我不懂autolisp。如何在vb中编写此代码。net/vba或C#。网

maratovich 发表于 2022-7-6 22:13:14

抬起你的眼睛

ursan 发表于 2022-7-6 22:15:28

 
我为什么说错了？

maratovich 发表于 2022-7-6 22:23:35

我为你写了一个VBA的例子
但是你没有看到我的例子吗？

ursan 发表于 2022-7-6 22:26:29

 
我看到了你的例子。但是当这些线有不同的角度时，它们并不能找到所有的线。

ronjonp 发表于 2022-7-6 22:30:18

很抱歉我不懂那些语言。

查看完整版本: 交叉线列表