ReneRam 发表于 2009-6-8 05:21:50

奇怪的发现,至少对我来说:点有维度!

我有了这个发现,至少对我来说,我开始了一个新的程序,用块填充封闭区域。这只是一个更大事物的开端,但通常我会第一次尝试使用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 *****

Jeff_M 发表于 2009-6-8 10:05:04

您正在基于使用可见对象的交叉选择集进行“检查”。当您更改PDMODE和PDSIZE变量时,对象的显示方式会有所不同,从而使选择能够根据点的显示“大”程度进行更多/更少的选择。这就是为什么使用数学计算的另一种IsInside解决方案会给出更好的结果。   

ReneRam 发表于 2009-6-8 11:37:32

我同意,我的意思是,我认为屏幕上显示的点只是屏幕上的图形,而不是AutoCAD可以“触摸”的东西,因为它会改变缩放比例。我确信,当选择时,即使是交叉,因为它是矢量绘图而不是图像,选择是纯数学的东西。

sinc 发表于 2009-6-8 12:11:54

我认为除了当前行为之外的任何行为都是不一致的。
以C3D点为例,它也可能附加了标签。如果我使用交叉窗口,即使交叉窗口只触及部分标签,我也希望它选择点。如果点被忽略,除非我特别将交叉窗口放在点节点周围,从用户的角度来看,这将更加烦人。
这意味着您不能使用您试图获得所需结果的方法,但我认为它与交叉窗口的工作方式是一致的。

ReneRam 发表于 2009-6-8 12:26:03

我想我没有解释我觉得奇怪的地方。
如果在IsInside函数中替换这一行:
    ' Fill the objSS
    objSS.SelectByPolygon acSelectionSetCrossingPolygon, PointsArray, _
      initCodes, varCodeValues

与:
    ' Fill the objSS
    objSS.SelectByPolygon acSelectionSetWindowPolygon, PointsArray, _
      initCodes, varCodeValues

您不是在“穿越”,而是在使用“窗口”,但在这种情况下,该区域充满了孔洞。
无论如何,这种方法对我的目的来说已经足够了,我只是在分享一些我认为不太为人所知的东西。
页: [1]
查看完整版本: 奇怪的发现,至少对我来说:点有维度!