社区 › Auto Lisp › 通过vb向块添加属性

comcu 发表于 2022-7-6 14:16:55

通过vb向块添加属性

你好
 
希望有人能帮忙
 
我在下面有一些代码，允许用户选择一个块，然后向块添加一个属性，该属性由块名称填充，基本上是零件号。这一切都很好，直到块以某种方式镜像，将x、y或z比例从1更改为-1。
 
因此，如果图形上有多个块，则会添加属性，在未镜像的块上，属性是正确的，但在已镜像的块上，属性要么倒置，要么向后，或者两者兼而有之。
 
我不完全理解的是，如果在图形中只有一个未镜像的块时添加属性，则属性很好，然后可以开始镜像该块，而该块反过来会自动更改上下颠倒的值，那么为什么在运行vba程序时它不这样做呢？
 
 
 

Public strMyBlockName As String

Sub SelSet_FindBlockName_StoreName()

   Dim MyBlockRef As AcadBlockReference
   Dim I As Double
   Dim MyoEnt As AcadEntity
   Dim MyAttTextStr As String


   On Error Resume Next
   ThisDrawing.SelectionSets("SelectBlock").Delete
   If Err Then Err.Clear
   With ThisDrawing.Utility
       '' create a new selectionset
       Set objSS = ThisDrawing.SelectionSets.Add("SelectBlock")

       '' let user select entities interactively
       objSS.SelectOnScreen

      'MyObjSS.SelectOnScreen FilterType, FilterData
      'MyObjSS.Select acSelectionSetAll 'FilterType, FilterData
       '' highlight the selected entities
       objSS.Highlight True
      

      
      
       '' pause for the user
       '.Prompt vbCr & objSS.Count & " entities selected"
       '.GetString False, vbLf & "Enter to continue "

       For Each MyoEnt In objSS
         If TypeOf MyoEnt Is AcadBlockReference Then
               Set MyBlockRef = MyoEnt
                     strMyBlockName = MyBlockRef.Name
                     
         End If
       Next
End With

   
                           MyOldBlockObjSS.Erase

      
   Call Add_Att
      
      
End Sub


Sub Add_Att()
   
   
' This example creates an attribute definition in a block.
   ' It then inserts the block. Then it changes the prompt string
   ' of the attribute definition, and inserts the block again.
   
   Call MakeStringUppercase
   
   ' Create the block
   Dim blockobj As AcadBlock
   Dim insertionPnt1(0 To 2) As Double
   Dim insertionPnt2(0 To 2) As Double

' insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
   'Set blockObj = ThisDrawing.Blocks.Add(insertionPnt1, "SFG101")
   
   Set blockobj = ThisDrawing.Blocks.Add(insertionPnt1, strMyBlockName)
   


   ' Define the attribute definition
   Dim attributeObj As AcadAttribute
   Dim height As Double
   Dim mode As Integer
   Dim prompt As String
   Dim tag As String
   Dim value As String
   
   height = 5
   mode = acAttributeModeNormal

      
       tag1 = "Part_No"
       prompt1 = "What is the Part No?"
       value1 = strMyBlockName
       insertionPnt1(0) = 5#: insertionPnt1(1) = 5: insertionPnt1(2) = 0



   ' Create the attribute definition on the block
       Set attributeObj = blockobj.AddAttribute(height, mode, prompt1, insertionPnt1, tag1, value1)


         
         
         
   ThisDrawing.SendCommand "_ATTSYNC" & vbCr & "NAME" & vbCr & strMyBlockName & vbCr

'Call SelSet_FindBlockName_StoreName



' ZoomAll

End Sub



 
提前感谢您的帮助。
 
Col公司

SEANT 发表于 2022-7-6 15:20:02

看看这个线程中的一些代码。如果比较MyBlockRef。XScaleFactor和。YScaleFactor为-1，然后可以调整myvaratt（i）。向后和。UpsideDown属性。
 
http://www.cadtutor.net/forum/showthread.php?t=25352

查看完整版本: 通过vb向块添加属性