请问用vba如何判断一个cad图形中的两个实体完全重合？ - VBA/VB/ActiveX/API 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第2页

chman 发表于 2015-7-4 22:41:34

For Each i In xian
   For Each j In xian1
         pderrort = False
         pderrorw = False
         pdtt = False
         pdtw = False
         pdwt = False
         pdww = False
         'i.Handle <> j.HandleÅÅ³ý×ÔÉíÅÐ¶Ï£¡£¡£¡£¡ ×¢Òâ,´Ë´¦ÅÐ¶Ï,±ØÐëÈÃIÒ»¸ö¸öµÄÅÐ¶Ï,²»ÄÜÒÅÂ©.
         If i.Handle <> j.Handle And Abs(i.StartPoint(0) - j.StartPoint(0)) < 0.0001 And Abs(i.StartPoint(1) - j.StartPoint(1)) < 0.0001 Then
            pdtt = True
         End If
         If i.Handle <> j.Handle And Abs(i.StartPoint(0) - j.EndPoint(0)) < 0.0001 And Abs(i.StartPoint(1) - j.EndPoint(1)) < 0.0001 Then
            pdtw = True
         End If
         If i.Handle <> j.Handle And Abs(i.EndPoint(0) - j.StartPoint(0)) < 0.0001 And Abs(i.EndPoint(1) - j.StartPoint(1)) < 0.0001 Then
            pdwt = True
         End If
         If i.Handle <> j.Handle And Abs(i.EndPoint(0) - j.EndPoint(0)) < 0.0001 And Abs(i.EndPoint(1) - j.EndPoint(1)) < 0.0001 Then
            pdww = True
         End If
         'Ö»Òª·¢ÏÖÓÐ¹²µã£¬¾Í²»ÈÏÎªµãÁ¬½ÓÓÐÎÊÌâ¡£
         If pdtt = True Or pdtw = True Then
            pderrort = True
         'ÏÂÃæÕâ¸öÅÐ¶ÏºÜÖØÒª,ÏÈÅÐ¶ÏÊÇ·ñÓÐÍ·Î²Ïà½Ó,Èç¹ûÓÐ,ÔòËµÃ÷ÏßÒÑ¾Í·Î²¶¼ÎÞ¶Ïµã!!!!!!!!
            If i.Thickness <> 2 And i.Thickness <> 3 Then
               i.Thickness = 1
            Else
               i.Thickness = 3
            End If
         End If
         If pdwt = True Or pdww = True Then
            pderrorw = True
            If i.Thickness <> 1 And i.Thickness <> 3 Then
               i.Thickness = 2
            Else
               i.Thickness = 3
            End If
         End If
   Next j
''    jingdutiao = jingdutiao + 1
''    ThisDrawing.Utility.Prompt jingdutiao & "/" & tongji
   'ÆðµãÅÐ¶ÏÎªFALSE £¬ËµÃ÷ÆðµãÊÇ¹ÂÁ¢µã¡£ÒÔÆðµãÎª°ë¾¶£¬¼Ó¸ö×¢¼Ç¡£¡£¡£¡£ÓÃÊ²Ã´×¢¼ÇºÃÄØ¡£°¥¡£¡£¶àµãºÜ½üÊ±£¬ºÜÄÑ×¼È·²é¿´ÄÄ¸öµãÓÐÎÊÌâ

Next i

''''''''''''''''''''''''''''''''''''''''''''''×¢Òâ,ÉÏÃæÒÑ¾ÅÐ¶ÏÁËËùÓÐ¶ËµãÓë¶ÏµãÖ®¼äÊÇ·ñ¹²µã,,,,
'''''''''''''''''''''''''''''''''''''''''''''ÌØ±ðÊÇ½«ÓÐÁ¬½ÓÏßÍ¨¹ýTHicknessÅÐ¶Ï³öÀ´ÁË

'''''''''''''''''''''''''''''''''''' 3    ´ú±íÍ·Î²¶¼ÓÐ¹²µã
'''''''''''''''''''''''''''''''''''2    ´ú±íÏß¶ÎÄ©¶ËÓÐ¹²µã
'''''''''''''''''''''''''''''''''''1    ´ú±íÏß¶ÎÆðµãÓÐ¹²µã
'''''''''''''''''''''''''''Ë¼Â·:thinckness = 3µÄ²»ÔÙÅÐ¶Ï,,,,,,,
Dim intPointsAs Variant
Dim jdi As Integer, jdj As Integer
For Each i In xian
   pderrort = False
   pderrorw = False
   pdtt = False
   pdww = False

   If i.Thickness <> 3 Then

         For Each j In xian1
         jdi = 0
         jdj = 0
            intPoints = i.IntersectWith(j, acExtendNone)       'ÔÚÁ½¸ö¶ÔÏó¾ù²»ÑÓÉìµÄÇé¿öÏÂ,Çó½»µã.
            'VarType(intPoints) <> vbEmpty       Èç¹ûÃ»ÓÐ½»µã,·µ»ØÖµ²»ÊÇÎªÁã,¶øÊÇÎª¿Õ!!!!!!
            If VarType(intPoints) <> vbEmpty Then
            '½»µã¾ÓÈ»¿ÉÄÜÓÐÈô¸É¸ö,ËùÒÔ,Òª×÷Ñ»·.....             jdi½»µã¸öÊý          jdj ×ø±êxyz
               For jdi = LBound(intPoints) To UBound(intPoints)
                     If i.Thickness = 1 And Abs(intPoints(jdj) - i.EndPoint(0)) < 0.0001 And Abs(intPoints(jdj + 1) - i.EndPoint(1)) < 0.0001 Then
                        pdww = True
                        i.Thickness = 3
                     End If
                     If i.Thickness = 2 And Abs(intPoints(jdj) - i.StartPoint(0)) < 0.0001 And Abs(intPoints(jdj + 1) - i.StartPoint(1)) < 0.0001 Then
                        pdtt = True
                        i.Thickness = 3
                     End If
                     '´¦ÀíÊ¼µãºÍÄ©µã,ÕâÀï»¹Òª½øÐÐÅÐ¶Ï.....×¢ÒâÅÐ¶ÏºóµÄ·½Ïò¶Ô²»¶Ô!!!
                     If i.Thickness = 0 And Abs(intPoints(jdj) - i.StartPoint(0)) < 0.0001 And Abs(intPoints(jdj + 1) - i.StartPoint(1)) < 0.0001 Then
                        If i.Thickness <> 2 And i.Thickness <> 3 Then
                           i.Thickness = 1
                        Else
                           i.Thickness = 3
                        End If
                     End If
                     If i.Thickness = 0 And Abs(intPoints(jdj) - i.EndPoint(0)) < 0.0001 And Abs(intPoints(jdj + 1) - i.EndPoint(1)) < 0.0001 Then
                        If i.Thickness <> 1 And i.Thickness <> 3 Then
                           i.Thickness = 2
                        Else
                           i.Thickness = 3
                        End If
                     End If
                     jdi = jdi + 2
                     jdj = jdj + 3
               Next
            End If
         Next j

   End If
Next i

'½â¾ö
' MsgBox tongji
'Ô°µÄ°ë¾¶´óÐ¡Í³Ò»ÉèÖÃ¡£´Ë´¦Îªcirclebig

circlebig = 1500
'ÏÔÊ¾×îÖÕ½á¹û....
For Each i In xian
   If i.Thickness = 2 Then
         Set MyCircle = ThisDrawing.ModelSpace.AddCircle(i.StartPoint, circlebig)
   ElseIf i.Thickness = 1 Then
         Set MyCircle = ThisDrawing.ModelSpace.AddCircle(i.EndPoint, circlebig)
   ElseIf i.Thickness = 0 Then
         Set MyCircle = ThisDrawing.ModelSpace.AddCircle(i.EndPoint, circlebig)
         Set MyCircle = ThisDrawing.ModelSpace.AddCircle(i.StartPoint, circlebig)
'    Else
'          i.Layer = "11"
'          i.Update
   End If

Next i
For Each i In xian
   'ÖØÖÃÎª³õÊ¼Öµ.
'    I.Thickness = 0
   i.Thickness = 0
Next i

页: 1 [2]

明经CAD社区's Archiver