维德发现，至少对我来说：点有维度！乐筑天下

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

维德发现，至少对我来说：点有维度！

我有了这个发现，至少对我来说，我开始了一个新的程序，用块填充一个封闭的区域。It#039；这只是一个更大的事情的开始，但通常我第一次尝试VBA，因为我发现开发速度更快
下面的代码创建了一个样本闭合区域，然后检查一个点（在我的例子中是块的插入点）是否在该区域内；有不同解决方案的常见问题。在我的例子中，a只是创建了一个临时点，并检查它是否在我的区域内，如果结果是真的，那么…插入块，否则跳到下一个点。通过测试，我发现我认为在AutoCAD中作为图形显示的PointStyle和PointSize变量具有真实尺寸。我改变了点样式，以直观地看到我的点要去哪里。我你运行代码两次，第二次运行PDMODE变量被更改的部分，你&#039；我会看到区别的。此外，如果在测试点是否在内部之前更改缩放部分，则会得到不同的结果。我认为点是一个没有维度的位置&nbsp
I&#039；我只是分享我的发现，以防有人没有#039；我不知道这件事

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

我没有&#039；用lisp或.Net进行计算，但我想它会给出相同的结果。

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

您是“；检查“；基于使用可见对象的交叉选择集。更改PDMODE时（&M）；PDSIZE变量对象以不同的方式显示，从而允许选择能够根据“如何”进行更多/更少的选择；“大”；将显示该点。这就是为什么使用数学计算的另一个IsInside解决方案会给出更好的结果&nbsp&nbsp；

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

我同意，我的意思是，我认为屏幕上显示的点只是屏幕上的一个图形，而不是AutoCAD可以做到的；触摸“；因为它改变了缩放。我深信，在选择的时候，即使是交叉，因为它#039；s的矢量图，而不是图像，选择是纯粹的数学。

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

我认为，除了当前的行为之外，任何其他行为都是不一致的
以C3D点为例，这些点可能也有标签&nbsp；如果我使用交叉窗口，我希望它选择点，即使交叉窗口仅接触标签的一部分&nbsp；如果忽略点，除非我在点节点周围专门放置交叉窗口，那么从用户角度来看，这将更加恼人
这意味着你可以&#039；不要使用这种方法，你试图得到你想要的结果，但我认为这与交叉窗口的工作方式是一致的。

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

&nbsp；我想我&#039；我没有解释我觉得奇怪的事情
如果替换IsInside函数中的此行：
' Fill the objSS
objSS.SelectByPolygon acSelectionSetCrossingPolygon, PointsArray, _
initCodes, varCodeValues
带有：
' Fill the objSS
objSS.SelectByPolygon acSelectionSetWindowPolygon, PointsArray, _
initCodes, varCodeValues
你&#039；re not“；交叉点；，你&#039；重复使用“a”；窗口；，但在这种情况下，该区域充满了孔洞
无论如何，这个方法对我来说已经足够有效了，我只是分享了一些我认为不是的东西；不太为人所知。

页: [1]

乐筑天下's Archiver

维德发现，至少对我来说：点有维度！