VBA如何实现删除图形文件中的重复实体
我想问在CAD文件中有重复的线和文字，如何实现删除图形文件中的重复实体？先谢谢了 难度大,怎样判断重复? 判断重复，对线判断两端点，对文本判断插入点和文本值 没这么简单.对线,每根线得与其它所有线比较,两根线的4个端点要在同一直线上.要做起来非常麻烦,对此不报希望. 有什么区别?建立选择集只不过是要比较的线的数目少一点,方法还是一样. 你说的问题我以前做过类似的东东：一个两人对弈围棋的程序，确实很复杂 object.delete要是不行你就用
ThisDrawing.SendCommand "_erase" & vbCr & "（要删除的东西）" & vbCr & vbCr
看看行么？有的东西我就是这么删的 本帖最后由 作者 于 2004-4-23 23:53:22 编辑
Public Function GetVal(Line1 As AcadLine, Line2 As AcadLine) As Integer
Dim c As AcadLine
Dim a(1) As Double, b(1) As Double
Dim d(2) As Double, e(2) As Double
If Line1.Angle <> Line2.Angle Then GetVal = 0: Exit Function
GetVal = 1
e(1) = 1
Set c = ThisDrawing.ModelSpace.AddLine(d, e)
If c.Angle = Line1.Angle Then
h = c.StartPoint
h(0) = h(0) + 1
c.StartPoint = h
End If
f = c.IntersectWith(Line1, acExtendBoth)
g = c.IntersectWith(Line2, acExtendBoth)
c.Delete
If Abs(f(0) - g(0)) < 10 ^ -8 And Abs(f(1) - g(1)) < 10 ^ -8 Then
GetVal = 2
If Line1.StartPoint(0) = Line1.EndPoint(0) Then
a(0) = Min(Line1.StartPoint(1), Line1.EndPoint(1))
a(1) = Max(Line1.StartPoint(1), Line1.EndPoint(1))
b(0) = Min(Line2.StartPoint(1), Line2.EndPoint(1))
b(1) = Max(Line2.StartPoint(1), Line2.EndPoint(1))
Else
a(0) = Min(Line1.StartPoint(0), Line1.EndPoint(0))
a(1) = Max(Line1.StartPoint(0), Line1.EndPoint(0))
b(0) = Min(Line2.StartPoint(0), Line2.EndPoint(0))
b(1) = Max(Line2.StartPoint(0), Line2.EndPoint(0))
End If
If (a(0) - b(1)) * (a(1) - b(0)) <= 0 Then GetVal = 3
End If
End Function
Function Min(Value1 As Variant, Value2 As Variant) As Variant
Min = Value1
If Value2 < Value1 Then Min = Value2
End Function
Function Max(Value1 As Variant, Value2 As Variant) As Variant
Max = Value1
If Value2 > Value1 Then Max = Value2
End Function这是一个判断两直线是否平行且重合的程序不平行返回0平行但不在一直线上返回1平行且在一直线上但不相交返回2平行且在一直线上且相交返回3下一步应该简单了吧
页:
[1]
2