OK, with the help I received here and my other research and the beginning of a bald spot on the side of my head from scratching while thinking, I was able to get this to work. I'm not sure how stable it is but it works. If anyone want's to adjust it to make it better - please feel free! I don't get my feelings easily hurt from constructive critism! Just ask Oleg. I can't tell you how many times he has reached over the internet and thumped me in the head!
Option ExplicitSub Example_GetSubEntity() Dim Object As Object Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant Dim MyStyle As String Dim MyWidth As Integer Dim i As Integer Dim REPLY As String MyStyle = "STANDARD" MyWidth = 1# On Error GoTo NOT_ENTITYTRYAGAIN:Do ThisDrawing.Utility.GetSubEntity Object, PickedPoint, TransMatrix, ContextData If Not Object.StyleName = MyStyle Then Object.StyleName = MyStyle Object.ScaleFactor = MyWidth End If Object.UpdateLoop Exit SubNOT_ENTITY: REPLY = MsgBox(" You have not selected an attribute" & vbCr & vbCr & "Press RETRY to continue or CANCEL to end the macro", vbRetryCancel, " A SPECIAL MESSAGE JUST FOR YOU") If REPLY = 4 Then Resume TRYAGAIN End IfEnd Sub If you used 'Option Explicit' better yet to cast all object
explicitly, so you have to cast an object as AttributeReference
Set attRef = Object
then change its properties, you will be avoid many mistakes
in your code
I posted you another loop example, sorry, not tested
See you,
页:
1
[2]