碰撞检测
大家好，I'；我们对三维实体进行了碰撞检测。基本上，它一个接一个地穿过所有实体，并创建所有与其他实体碰撞的三维实体。这里是#039；这就是我想要扩展函数的地方。因为（和我遇到的许多其他人一样）我们用预定义的块绘制了很多图，所以我需要分解所有的块（也由三维实体构成）才能使函数正常运行。这可以避免吗？我的意思是，我可以检查块内是否存在干涉三维实体吗
Grz，Jura
不可以。您必须检查每个块是否存在实体，然后对照模型空间的其余部分检查每个块引用
（当然，你可以检查块本身内部的冲突。）
一种更简单的方法，尽管很混乱，但它是分解块参照（这使块参照保持不变）将其添加到数组中，并删除不'；t碰撞。
你能解释一下吗
如何分解blockref并保持blockrefs不变？什么是blockref？是积木本身吗
Block是定义，BlockRef是插入到dwg中的块的实例 正如CmdrDuh所说，一个块就像一个对象及其相对于零的位置的列表
块和块引用是非常不同的，您需要掌握其中的差异才能编写成功的代码
尝试使用explode的一个小sub，然后查看结果。 我会的
我猜：我'；我会回来的
给小费的人发Thx
在这方面花了更多的时间后，感觉#039；足够好#039；和你们分享产品
代码+结果窗口见附件
这是代码。我在我的SSET和数组上玩了一点。对我来说，一定有更简单的方法来处理这件事。但是，一些函数不接受数组，而其他函数不接受SSET'#####################################
'# ClashDetect creates 3D solids from
'# selected 3D solids where they
'# interfere with eachother
'# Sub by J.v.d.Staaij
'# V1.0
'#####################################
Sub ClashDetect()
'original
Dim originalItems As AcadSelectionSet
'copy
Dim copyItem As AcadEntity
Dim CopiedItemsSSet As AcadSelectionSet
'explode
Dim TempEntity As AcadEntity
Dim TempItem As Variant
Dim TempArray(0 To 0) As AcadBlockReference
Dim Counter As Integer
Dim TempSubEntity As Acad3DSolid
'clas detect
Dim ClashSolid As Acad3DSolid
Dim newLayer, oldLayer
Dim ChecksExecuted As Long
Dim FoundClash As Long
Dim counterNotChecked As Long
Dim SolidCreationErrorCount As Long
'pre check
Dim obj1 As AcadEntity
Dim obj2 As AcadEntity
Dim pmin As Variant
Dim pmax As Variant
Dim qmin As Variant
Dim qmax As Variant
Dim Clash As Integer
'Let user select items
Set originalItems = ThisDrawing.SelectionSets.Add("block")
originalItems.SelectOnScreen
'Create templayer
Set tempLayer = ThisDrawing.Layers.Add("TEMPLAYER")
'Jumpout when nothing selected
If originalItems.Count = 0 Then GoTo Einde
'define dynamic copyarray
ReDim copyArray(0 To originalItems.Count - 1) As AcadEntity
'copy each item in original selection
For i = 0 To originalItems.Count - 1
Set copyItem = originalItems(i).Copy()
copyItem.Layer = "TEMPLAYER"
Set copyArray(i) = copyItem
Next
'create copy selectionset
Set CopiedItemsSSet = ThisDrawing.SelectionSets.Add("ArrayName")
'store copyarray in selectionset
CopiedItemsSSet.AddItems copyArray
'Explode blockrefs (and re-explode if necesary)
ExplodeAgain:
Counter = 0
For Each TempEntity In CopiedItemsSSet
If TypeOf TempEntity Is AcadBlockReference Then
Set TempArray(0) = TempEntity
CopiedItemsSSet.RemoveItems TempArray
TempItem = TempEntity.Explode
TempEntity.Delete
CopiedItemsSSet.AddItems (TempItem)
Counter = Counter + 1
End If
Next
If Counter0 Then GoTo ExplodeAgain
'store currenty layer
Set oldLayer = ThisDrawing.ActiveLayer
'create layer for clashing items
Set newLayer = ThisDrawing.Layers.Add("DetectedClash")
ThisDrawing.ActiveLayer = newLayer
ThisDrawing.ActiveLayer.color = 6
'Set results counters
ChecksExecuted = 0
FoundClash = 0
counterNotChecked = 0
For i = 0 To CopiedItemsSSet.Count - 1
'Check if item is 3D Solid
If Not (CopiedItemsSSet(i).ObjectName = "AcDb3dSolid") Then
counterNotChecked = counterNotChecked + 1
GoTo SkipCheckObject
End If
' start checking
For j = i + 1 To CopiedItemsSSet.Count - 1
If Not (CopiedItemsSSet(j).ObjectName = "AcDb3dSolid") Then GoTo SkipCheckAgainst 'Check if against-item is 3D Solid
If Not (CopiedItemsSSet(i) Is CopiedItemsSSet(j)) Then 'Don't do self check
'Do pre check (easier for acad to compare bounding boxes (10-20x faster))
CopiedItemsSSet(i).GetBoundingBox pmin, pmax
CopiedItemsSSet(j).GetBoundingBox qmin, qmax
Clash = 0
For k = 0 To 2
limiet = (pmax(k) - pmin(k) + qmax(k) - qmin(k))
afstand = Abs(pmax(k) + pmin(k) - qmax(k) - qmin(k))
If afstand < limiet Then
Clash = Clash + 1
End If
Next k
If Clash = 3 Then ' Precheck is true
On Error GoTo ErrorSolidCreate 'Take care of Modeling Operation Errors
Set ClashSolid = CopiedItemsSSet(i).CheckInterference(CopiedItemsSSet(j), True)
On Error GoTo ErrorTrap
' set found clash to DetectedClash layer
If Not (ClashSolid Is Nothing) Then
ClashSolid.Layer = "DetectedClash"
FoundClash = FoundClash + 1
End If 'Not (ClashSolid Is Nothing) Then
ChecksExecuted = ChecksExecuted + 1
End If 'If Clash = 3 Then
Else
End If 'If Not (CopiedItemsSSet(i) Is CopiedItemsSSet(j)) Then 'Don't do self check
SkipCheckAgainst:
Next
SkipCheckObject:
Next
'result window
ClashDetectResults.Results.Caption = "" & ChecksExecuted & vbCrLf & _
FoundClash & vbCrLf & _
counterNotChecked & vbCrLf & _
SolidCreationErrorCount & ""
ClashDetectResults.Show
'Restore original layer
ThisDrawing.ActiveLayer = oldLayer
'delete templayer
'ThisDrawing.Layers.Delete (TO DO)
'Error trapping
ErrorTrap:
CopiedItemsSSet.Erase
CopiedItemsSSet.Delete
Einde:
originalItems.Delete
Exit Sub
ErrorSolidCreate:
SolidCreationErrorCount = SolidCreationErrorCount + 1
Resume Next
End Sub
页:
[1]