与非工作corr相交

4gokay · 发表于 2022-7-6 22:23:05

嗨，我是Acad 2010用户。随附的文件，似乎有问题。我在折线上遇到了问题，你改变了物体的位置。当我移动到区域1时。区域1内的多段线修剪长度正确。但是当我移动到区域2内的区域2多段线时，修剪的长度不正确。保留一小段洋红色多段线。

是UCS值比格是怎么回事？

但是，当您进行查询时。Acad在区域2中发现2个交点，不正确。Acad在区域1中找到一个交点，正确。

我不理解这个问题。谢谢你的帮助。

（所有Z值归零。所有对象都是多段线）
修剪图纸

eldon · 发表于 2022-7-6 22:29:26

您的问题与您所在的图形区域无关，而是与使用Trim命令的方法有关。

如果通过选择刀刃进行修剪，则会在区域1中得到结果。

如果通过让AutoCAD选择切割边缘进行修剪，则会在区域2中得到结果。多段线不是曲线拟合的，由一系列直线组成。发生的情况是，AutoCAD选择了真实交点右侧的多段线线段，并使用该线（图片中的黑色虚线）的假想延伸进行修剪。这就是你的不同之处。

4gokay · 发表于 2022-7-6 22:33:55

很抱歉，我不明白完整的解决方案。我的英语有点差。有很多折线图。我都做了。我该怎么办。我需要的多段线长度。我应该在哪里设置？你能一步一步地告诉我吗。我很抱歉。非常感谢。

eldon · 发表于 2022-7-6 22:38:43

使用Trim命令时，请继续查看命令行，该命令行告诉您要做什么。

首先，它告诉你“选择切割边缘”，然后“选择对象”。如果此时按return键，则允许AutoCAD选择剪切边。
所以你必须选择你的切割边缘，在这里是黄色的多段线。选择完切割边后，按Return键让AutoCAD知道您已经选择完切割边。
然后命令行显示“选择要修剪的对象……”然后你选择你的洋红线。

如果您仍然不理解，那么您应该查看帮助文件，这些文件应该是您自己的语言。

4gokay · 发表于 2022-7-6 22:41:21

Hi eldon谢谢你的帮助。

但有一个问题。我到达了十字路口。用VBA指向读取。非常重要。但它显示了一个不正确的结果。我不确定这是不是VBA论坛的地方？VBA不工作为什么？你有认识的吗？提前谢谢。同样的两点。但结果与2不同。非常卡住。我需要找到。

/////////

copy


Sub IPNT()
Dim objSS As AcadSelectionSet
Dim objSS2 As AcadSelectionSet
Dim Poly1 As AcadLWPolyline
Dim Poly2 As AcadLWPolyline
On Error Resume Next
ThisDrawing.SelectionSets("TempSSet1").Delete
On Error Resume Next
Set objSS = ThisDrawing.SelectionSets.Add("TempSSet1")
If Err Then Exit Sub
MsgBox "Select Poly 1"
objSS.SelectOnScreen
For Each Poly1 In objSS
Exit For: Next
On Error Resume Next
ThisDrawing.SelectionSets("TempSSet2").Delete
On Error Resume Next
Set objSS2 = ThisDrawing.SelectionSets.Add("TempSSet2")
If Err Then Exit Sub
MsgBox "Select Poly 2"
objSS2.SelectOnScreen
For Each Poly2 In objSS2
Exit For: Next
pts = Poly1.IntersectWith(Poly2, acExtendNone)
MsgBox "X= " & pts(0) & vbCr & "Y= " & pts(1), vbInformation, "Intersection Point"
End Sub

/////////

在同一代码区域1中给出不同的结果。区域2也给出了不同的结果。

谢谢你的帮助。
trim2.dwg

4gokay · 发表于 2022-7-6 22:43:51

我到达了两条多段线的交点。该过程将重复多次。然而，根据VBA代码尝试不同的UCS坐标。区域1中的代码工作正常。在错误的区域2工作。

同样，还有修剪问题。你可以看到下面的链接。

http://www.cadtutor.net/forum/showthread.php?76891-修剪多段线长度错误

/////////

copy


Sub IPNT()
Dim objSS As AcadSelectionSet
Dim objSS2 As AcadSelectionSet
Dim Poly1 As AcadLWPolyline
Dim Poly2 As AcadLWPolyline
On Error Resume Next
ThisDrawing.SelectionSets("TempSSet1").Delete
On Error Resume Next
Set objSS = ThisDrawing.SelectionSets.Add("TempSSet1")
If Err Then Exit Sub
MsgBox "Select Poly 1"
objSS.SelectOnScreen
For Each Poly1 In objSS
Exit For: Next
On Error Resume Next
ThisDrawing.SelectionSets("TempSSet2").Delete
On Error Resume Next
Set objSS2 = ThisDrawing.SelectionSets.Add("TempSSet2")
If Err Then Exit Sub
MsgBox "Select Poly 2"
objSS2.SelectOnScreen
For Each Poly2 In objSS2
Exit For: Next
pts = Poly1.IntersectWith(Poly2, acExtendNone)
MsgBox "X= " & pts(0) & vbCr & "Y= " & pts(1), vbInformation, "Intersection Point"
End Sub

/////////

谢谢你的帮助。

trim2.dwg

Tyke · 发表于 2022-7-6 22:48:51

我看不出选择集保存单个实体的意义，你已经有了两个多段线的变量，然后将它们与GETENTITY一起使用。你可以用相应的代码、两个循环和第一个消息框省略选择集。您也没有声明变量“pts”。

请尝试以下代码：

copy


Sub IPNT()
   Dim Poly1   As AcadLWPolyline
   Dim Poly2   As AcadLWPolyline
   Dim pts     As Variant
   Dim varPick As Variant
   Dim objEnt  As AcadEntity
   
   ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 1: "
   If objEnt.ObjectNAme = "AcDbPolyline" then
       Set Poly1 = objEnt
   End If
   
   ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 1: "
   If objEnt.ObjectNAme = "AcDbPolyline" then
       Set Poly1 = objEnt
   End If
   
   pts = Poly1.IntersectWith(Poly2, acExtendNone)
   
   MsgBox "X= " & pts(0) & vbCr & "Y= " & pts(1), vbInformation, "Intersection Point"
   
End Sub

4gokay · 发表于 2022-7-6 22:53:57

问题不是你键入了Tyke。交叉口的工作不正常。感谢您的关注。

Tyke · 发表于 2022-7-6 22:57:16

你能更具体地描述你的问题吗，我不明白它是什么。你说的到底是什么意思
? 什么工作不正常？
描述你采取的步骤以及哪些结果是错误的。在绘图中检查两条多段线的物理交点坐标，这些坐标是否与您的程序提供的一致？

4gokay · 发表于 2022-7-6 23:02:22

嗨，小家伙。我用了一种更具描述性的方式。正在等待帮助。提前谢谢。

当我移动到区域2时，对象会出错。欺骗我。（UCS）坐标使问题成为？

copy

Sub DEDECTIPONPL()
   Dim Poly1   As AcadLWPolyline
   Dim Poly2   As AcadLWPolyline
   Dim pts     As Variant
   Dim varPick As Variant
   Dim objEnt  As AcadEntity
   ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 1: "
   If objEnt.ObjectName = "AcDbPolyline" Then
       Set Poly1 = objEnt
   End If
   ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 2: "
   If objEnt.ObjectName = "AcDbPolyline" Then
       Set Poly2 = objEnt
   End If
   'This Project can be dedected, 1,2 or 3 intersection point of Plines.
   'This program will detect the number of point of intersection.
   pts = Poly1.IntersectWith(Poly2, acExtendNone)
   If UBound(pts) = 2 Then
   MsgBox "1 intersection point dedected." & vbCr & _
   "X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr, _
   vbInformation, "Intersection Point Dedector"
   ElseIf UBound(pts) = 5 Then
   MsgBox "2 intersection point dedected." & vbCr & _
   "X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr & _
   "X= " & pts(3) & ", " & "Y= " & pts(4), _
   vbInformation, "Intersection Point Dedector"
   ElseIf UBound(pts) = 8 Then
   MsgBox "3 intersection point dedected." & vbCr & _
   "X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr & _
   "X= " & pts(3) & ", " & "Y= " & pts(4) & vbCr & _
   "X= " & pts(6) & ", " & "Y= " & pts(7), _
   vbInformation, "Intersection Point Dedector"
   Else
   MsgBox "intersection point number > 3" & vbCr & "Program Limits Exceed"
   End If
End Sub

trim3.dwg

[编程交流] 与非工作corr相交

发表回复

精选推荐