乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 68|回复: 4

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

[复制链接]

2

主题

7

帖子

2

银币

初来乍到

Rank: 1

铜币
15
发表于 2009-6-8 05:21:50 | 显示全部楼层 |阅读模式
我有了这个发现,至少对我来说,我开始了一个新的程序,用块填充封闭区域。这只是一个更大事物的开端,但通常我会第一次尝试使用VBA,因为我发现开发速度更快
下面的代码创建了一个示例闭合区域,然后检查一个点(在我的例子中是块的插入点)是否在该区域内;有不同解决方案的常见问题。在我的例子中,a只是创建了一个临时点,并检查它是否在我的区域内,如果结果为真,那么…插入块,否则跳到下一个点。通过测试,我发现PointStyle和PointSize变量(我认为是AutoCAD中的图形显示)具有真实尺寸。我改变了点样式,以直观地看到我的点的方向。如果您运行两次代码,并在第二次运行时对PDMODE变量发生更改的部分进行注释,您将看到差异。此外,如果在测试点是否在内部之前使用缩放部件进行更改,则会得到不同的结果。我以为一个点是一个没有维度的位置。
我只是分享我的发现,以防有人不知道
  1. Option Explicit
  2. Sub TestPointDimension()
  3.     ' Draw a closed polyline
  4.     Dim points(7) As Double
  5.     points(0) = 100#: points(1) = 10#
  6.     points(2) = 200#: points(3) = 50#
  7.     points(4) = 100#: points(5) = 100#
  8.     points(6) = 0#: points(7) = 50#
  9.     Dim objLWPoly As AcadLWPolyline
  10.     Set objLWPoly = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
  11.     objLWPoly.Closed = True
  12.    
  13.     ' Set Spacing of points for the test
  14.     ' I have set the spacing to 5 just to just to have more false points
  15.     ' results
  16.     Dim XSpacing As Double: XSpacing = 5#
  17.     Dim YSpacing As Double: YSpacing = 5#
  18.    
  19.     ' Create TestPoint
  20.     Dim TestPoint(2) As Double
  21.     TestPoint(0) = 0#: TestPoint(1) = 0#: TestPoint(2) = 0#
  22.    
  23.     ' Update Viewport
  24.     ' This is needed to optimize the SelectByPolygon:
  25.     ' ONLY objects VISIBLE in screen are evaluated
  26.     Application.ZoomExtents
  27.     Application.Update
  28.    
  29.    
  30.     ' Test with PDMode = 66
  31.     ThisDrawing.SetVariable "PDMODE", 66
  32.     ' I get 419 points Inside the closed area
  33.     ' and 44 of these are Outside the closed area
  34. '    ' Test with PDMode = 0
  35. '    ThisDrawing.SetVariable "PDMODE", 0
  36. '    ' I get 375 points Inside the closed area
  37.    
  38.     ' Star Testing points
  39.     Dim objPoint As AcadPoint
  40.     ' I'm intentionaly going outside the closed area
  41.     Do While TestPoint(1)  150 Then Exit Do
  42.             If TestPoint(0) > 250 Then GoTo UpdatePto
  43.             ' Insert Points
  44.             Set objPoint = ThisDrawing.ModelSpace.AddPoint(TestPoint)
  45.             Application.Update
  46.             ' Check if point is inside the closed area
  47.             If Not IsInside(objPoint.Coordinates, objLWPoly) Then
  48.                 ' Delete point
  49.                 objPoint.Delete
  50.             End If
  51. UpdatePto:
  52.             ' Update Insert Point
  53.             TestPoint(0) = TestPoint(0) + XSpacing
  54.         Loop
  55.     ' increment row
  56.     TestPoint(0) = 0#
  57.     TestPoint(1) = TestPoint(1) + YSpacing
  58.     TestPoint(2) = TestPoint(2)
  59. Loop
  60.    
  61.    
  62. End Sub
  63. ' Checks if a Point is inside a lwPolyline
  64. Function IsInside(ByVal acPoint As Variant, lwPoly As AcadLWPolyline) As Boolean
  65.     ' Initialize Return value
  66.     IsInside = False
  67.     Dim objSS As AcadSelectionSet       ' temporary SelectionSet
  68.     Dim initCodes(2) As Integer         ' objSS filter codes
  69.     Dim varCodeValues(2) As Variant     ' objSS filter values
  70.     Dim retCoords As Variant            ' lwPoly coordinates
  71.     Dim PointsArray() As Double         ' Array of 3D Points for objSS crossing polygon
  72.     Dim retPto As Variant               ' coordinates of found point
  73.     Dim ent As AcadEntity               ' entity
  74.    
  75.     Dim i As Integer                    ' counter
  76.     Dim j As Integer                    ' counter
  77.    
  78.     ' Create SelectionSet
  79.     Set objSS = PowerSet("myPolygon")
  80.    
  81.     ' DXF Filter
  82.     initCodes(0) = -4
  83.     varCodeValues(0) = ""
  84.     ' Retrieve lwPolyline Coordiantes and fill 3D Points for Crossing Polygon
  85.     retCoords = lwPoly.Coordinates
  86.     ReDim PointsArray((((UBound(retCoords) + 1) / 2) * 3) - 1)
  87.     ' get the X coordinates
  88.     For i = 0 To UBound(PointsArray)
  89.         For j = 0 To UBound(retCoords) Step 2
  90.             PointsArray(i) = retCoords(j)
  91.             i = i + 3
  92.         Next j
  93.     Next i
  94.     ' get the Y coordiantes
  95.     For i = 1 To UBound(PointsArray)
  96.         For j = 1 To UBound(retCoords) Step 2
  97.             PointsArray(i) = retCoords(j)
  98.             i = i + 3
  99.         Next j
  100.     Next i
  101.     ' fill the Z coordinates with 0, lwPolyline doesn't have Z
  102.     For i = 2 To UBound(PointsArray) Step 3
  103.        PointsArray(i) = 0
  104.     Next i
  105.     ' Fill the objSS
  106.     objSS.SelectByPolygon acSelectionSetCrossingPolygon, PointsArray, _
  107.         initCodes, varCodeValues
  108.     ' get ents in objSS
  109.     If objSS.Count >= 1 Then
  110.         For Each ent In objSS
  111.             retPto = ent.Coordinates
  112.             If retPto(0) = acPoint(0) And retPto(1) = acPoint(1) Then
  113.                 IsInside = True
  114.                 Exit Function
  115.             Else
  116.                 IsInside = False
  117.             End If
  118.         Next ent
  119.     Else
  120.         IsInside = False
  121.     End If
  122. End Function
  123. 'Restituisce un 'SelectionSet' evitando i nomi duplicati
  124. ' Credit goes to Randal Rath's Code Troute I think, I use this since (?)
  125. Function PowerSet(setName As String) As AcadSelectionSet
  126.     Dim objSS As AcadSelectionSet
  127.     Dim objSSCol As AcadSelectionSets
  128.     On Error GoTo ErrorHandler
  129.     Set objSSCol = ThisDrawing.SelectionSets
  130.     For Each objSS In objSSCol
  131.         If objSS.Name = setName Then
  132.             objSSCol.Item(setName).Delete
  133.             Exit For
  134.         End If
  135.     Next
  136.     Set objSS = objSSCol.Add(setName)
  137.     Set PowerSet = objSS
  138. ExitHere:
  139.     Exit Function
  140. ErrorHandler:
  141.     Select Case Err.Number
  142.         Case Else
  143.             MsgBox Err.Description
  144.             Err.Clear
  145.             Resume ExitHere
  146.         End Select
  147. End Function

我还没有用lisp或.Net进行计算,但我想它会给出相同的结果。

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

71

主题

928

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1230
发表于 2009-6-8 10:05:04 | 显示全部楼层
您正在基于使用可见对象的交叉选择集进行“检查”。当您更改PDMODE和PDSIZE变量时,对象的显示方式会有所不同,从而使选择能够根据点的显示“大”程度进行更多/更少的选择。这就是为什么使用数学计算的另一种IsInside解决方案会给出更好的结果。   
回复

使用道具 举报

2

主题

7

帖子

2

银币

初来乍到

Rank: 1

铜币
15
发表于 2009-6-8 11:37:32 | 显示全部楼层
我同意,我的意思是,我认为屏幕上显示的点只是屏幕上的图形,而不是AutoCAD可以“触摸”的东西,因为它会改变缩放比例。我确信,当选择时,即使是交叉,因为它是矢量绘图而不是图像,选择是纯数学的东西。
回复

使用道具 举报

4

主题

50

帖子

5

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

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

使用道具 举报

2

主题

7

帖子

2

银币

初来乍到

Rank: 1

铜币
15
发表于 2009-6-8 12:26:03 | 显示全部楼层
我想我没有解释我觉得奇怪的地方。
如果在IsInside函数中替换这一行:
  1.     ' Fill the objSS
  2.     objSS.SelectByPolygon acSelectionSetCrossingPolygon, PointsArray, _
  3.         initCodes, varCodeValues

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

您不是在“穿越”,而是在使用“窗口”,但在这种情况下,该区域充满了孔洞。
无论如何,这种方法对我的目的来说已经足够了,我只是在分享一些我认为不太为人所知的东西。
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-2 03:38 , Processed in 0.587451 second(s), 62 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表