奇怪的发现,至少对我来说:点有维度!
我有了这个发现,至少对我来说,我开始了一个新的程序,用块填充封闭区域。这只是一个更大事物的开端,但通常我会第一次尝试使用VBA,因为我发现开发速度更快下面的代码创建了一个示例闭合区域,然后检查一个点(在我的例子中是块的插入点)是否在该区域内;有不同解决方案的常见问题。在我的例子中,a只是创建了一个临时点,并检查它是否在我的区域内,如果结果为真,那么…插入块,否则跳到下一个点。通过测试,我发现PointStyle和PointSize变量(我认为是AutoCAD中的图形显示)具有真实尺寸。我改变了点样式,以直观地看到我的点的方向。如果您运行两次代码,并在第二次运行时对PDMODE变量发生更改的部分进行注释,您将看到差异。此外,如果在测试点是否在内部之前使用缩放部件进行更改,则会得到不同的结果。我以为一个点是一个没有维度的位置。
我只是分享我的发现,以防有人不知道
Option Explicit
Sub TestPointDimension()
' Draw a closed polyline
Dim points(7) As Double
points(0) = 100#: points(1) = 10#
points(2) = 200#: points(3) = 50#
points(4) = 100#: points(5) = 100#
points(6) = 0#: points(7) = 50#
Dim objLWPoly As AcadLWPolyline
Set objLWPoly = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
objLWPoly.Closed = True
' Set Spacing of points for the test
' I have set the spacing to 5 just to just to have more false points
' results
Dim XSpacing As Double: XSpacing = 5#
Dim YSpacing As Double: YSpacing = 5#
' Create TestPoint
Dim TestPoint(2) As Double
TestPoint(0) = 0#: TestPoint(1) = 0#: TestPoint(2) = 0#
' Update Viewport
' This is needed to optimize the SelectByPolygon:
' ONLY objects VISIBLE in screen are evaluated
Application.ZoomExtents
Application.Update
' Test with PDMode = 66
ThisDrawing.SetVariable "PDMODE", 66
' I get 419 points Inside the closed area
' and 44 of these are Outside the closed area
' ' Test with PDMode = 0
' ThisDrawing.SetVariable "PDMODE", 0
' ' I get 375 points Inside the closed area
' Star Testing points
Dim objPoint As AcadPoint
' I'm intentionaly going outside the closed area
Do While TestPoint(1)150 Then Exit Do
If TestPoint(0) > 250 Then GoTo UpdatePto
' Insert Points
Set objPoint = ThisDrawing.ModelSpace.AddPoint(TestPoint)
Application.Update
' Check if point is inside the closed area
If Not IsInside(objPoint.Coordinates, objLWPoly) Then
' Delete point
objPoint.Delete
End If
UpdatePto:
' Update Insert Point
TestPoint(0) = TestPoint(0) + XSpacing
Loop
' increment row
TestPoint(0) = 0#
TestPoint(1) = TestPoint(1) + YSpacing
TestPoint(2) = TestPoint(2)
Loop
End Sub
' Checks if a Point is inside a lwPolyline
Function IsInside(ByVal acPoint As Variant, lwPoly As AcadLWPolyline) As Boolean
' Initialize Return value
IsInside = False
Dim objSS As AcadSelectionSet ' temporary SelectionSet
Dim initCodes(2) As Integer ' objSS filter codes
Dim varCodeValues(2) As Variant ' objSS filter values
Dim retCoords As Variant ' lwPoly coordinates
Dim PointsArray() As Double ' Array of 3D Points for objSS crossing polygon
Dim retPto As Variant ' coordinates of found point
Dim ent As AcadEntity ' entity
Dim i As Integer ' counter
Dim j As Integer ' counter
' Create SelectionSet
Set objSS = PowerSet("myPolygon")
' DXF Filter
initCodes(0) = -4
varCodeValues(0) = ""
' Retrieve lwPolyline Coordiantes and fill 3D Points for Crossing Polygon
retCoords = lwPoly.Coordinates
ReDim PointsArray((((UBound(retCoords) + 1) / 2) * 3) - 1)
' get the X coordinates
For i = 0 To UBound(PointsArray)
For j = 0 To UBound(retCoords) Step 2
PointsArray(i) = retCoords(j)
i = i + 3
Next j
Next i
' get the Y coordiantes
For i = 1 To UBound(PointsArray)
For j = 1 To UBound(retCoords) Step 2
PointsArray(i) = retCoords(j)
i = i + 3
Next j
Next i
' fill the Z coordinates with 0, lwPolyline doesn't have Z
For i = 2 To UBound(PointsArray) Step 3
PointsArray(i) = 0
Next i
' Fill the objSS
objSS.SelectByPolygon acSelectionSetCrossingPolygon, PointsArray, _
initCodes, varCodeValues
' get ents in objSS
If objSS.Count >= 1 Then
For Each ent In objSS
retPto = ent.Coordinates
If retPto(0) = acPoint(0) And retPto(1) = acPoint(1) Then
IsInside = True
Exit Function
Else
IsInside = False
End If
Next ent
Else
IsInside = False
End If
End Function
'Restituisce un 'SelectionSet' evitando i nomi duplicati
' Credit goes to Randal Rath's Code Troute I think, I use this since (?)
Function PowerSet(setName As String) As AcadSelectionSet
Dim objSS As AcadSelectionSet
Dim objSSCol As AcadSelectionSets
On Error GoTo ErrorHandler
Set objSSCol = ThisDrawing.SelectionSets
For Each objSS In objSSCol
If objSS.Name = setName Then
objSSCol.Item(setName).Delete
Exit For
End If
Next
Set objSS = objSSCol.Add(setName)
Set PowerSet = objSS
ExitHere:
Exit Function
ErrorHandler:
Select Case Err.Number
Case Else
MsgBox Err.Description
Err.Clear
Resume ExitHere
End Select
End Function
我还没有用lisp或.Net进行计算,但我想它会给出相同的结果。
**** Hidden Message ***** 您正在基于使用可见对象的交叉选择集进行“检查”。当您更改PDMODE和PDSIZE变量时,对象的显示方式会有所不同,从而使选择能够根据点的显示“大”程度进行更多/更少的选择。这就是为什么使用数学计算的另一种IsInside解决方案会给出更好的结果。 我同意,我的意思是,我认为屏幕上显示的点只是屏幕上的图形,而不是AutoCAD可以“触摸”的东西,因为它会改变缩放比例。我确信,当选择时,即使是交叉,因为它是矢量绘图而不是图像,选择是纯数学的东西。 我认为除了当前行为之外的任何行为都是不一致的。
以C3D点为例,它也可能附加了标签。如果我使用交叉窗口,即使交叉窗口只触及部分标签,我也希望它选择点。如果点被忽略,除非我特别将交叉窗口放在点节点周围,从用户的角度来看,这将更加烦人。
这意味着您不能使用您试图获得所需结果的方法,但我认为它与交叉窗口的工作方式是一致的。 我想我没有解释我觉得奇怪的地方。
如果在IsInside函数中替换这一行:
' Fill the objSS
objSS.SelectByPolygon acSelectionSetCrossingPolygon, PointsArray, _
initCodes, varCodeValues
与:
' Fill the objSS
objSS.SelectByPolygon acSelectionSetWindowPolygon, PointsArray, _
initCodes, varCodeValues
您不是在“穿越”,而是在使用“窗口”,但在这种情况下,该区域充满了孔洞。
无论如何,这种方法对我的目的来说已经足够了,我只是在分享一些我认为不太为人所知的东西。
页:
[1]