For my next trick...

OK. I spoke about it before, so now I will show how to make the entities disappear. No peeking... Oh, enough of that. Feed this SUB your selection set and tada. Presto change-o, it has disappeared. Stay tuned.

Public Sub MakeObjSsInvisible(ByRef acSS As AcadSelectionSet)
'------------------------------------------------------------------------------
'
'Arguments: AutoCAD selection set
'Returns: None
'Caveats: Must unlock the layer they reside on first or it does not work
'------------------------------------------------------------------------------
Dim sCurrLyr As String
Dim objLayer As Object ' AcadLayer
Dim objLayers As Object 'AcadLayers
Dim acEnt As AcadObject
'''''''''''''''''''''''''''''''''''''''
For Each acEnt In acSS
sCurrLyr = acEnt.layer
Set objLayer = objLayers.Item(sCurrLyr)
If objLayer.Lock Then
objLayer.Lock = False 'unlock it
acEnt.Visible = False
objLayer.Lock = True 'lock it back up
Else
acEnt.Visible = False
End If
acEnt.Update
Next

If Not acSS Is Nothing Then
acSS.Delete
End If

End Sub

On the code again...

I decided (when I remember) to post a code snippet each week. Seems like so many are learning and wanting to learn customization that I would give back a little of what I have gained. This week is a simple little example of getting info from your user by way of an input box. Its fairly quick and does not require you to create a new form or code it. Works nice with text input. Enjoy.

Private Function GetStartingItemNo() As String
Dim sPrompt As String
Dim sTitle As String
Dim sDefault As String
'''''''''''''''''''''''''''''''''''''''
sPrompt = "Input Starting itemNumber"
sTitle = "Item Numbering"
sDefault = "1"
GetStartingItemNo = InputBox(sPrompt, sTitle, sDefault)

End Function

5 Minutes Of Fame

I recently had some of my code posted on Cadalyst. I am posting it here for those of you who may need to copy attributes from one block to another block. We do this semi-often with various title blocks from customers and it comes in handy for "copying" information around. Enjoy.

Public Sub UserCopyAttsFromBlkToAnotherBlk()
'------------------------------------------------------------------------------
'user selects block and then selects attributed block to match to
'
'------------------------------------------------------------------------------
Dim vAtts As Variant
Dim vAtts2 As Variant
Dim sPrompt As String
'''''''''''''''''''''''''''''''''''''''
On Error GoTo ErrHandler

sPrompt = "Select Source Attributed Block: "
vAtts = UserGetBlockWithAtts(sPrompt).GetAttributes

sPrompt = "Select Destination Attributed Block: "
vAtts2 = UserGetBlockWithAtts(sPrompt).GetAttributes

Call CopySameAttsFromBlkToBlk(vAtts, vAtts2)

ErrHandler:
Select Case Err.Number
Case 0
Case Else
Err.Clear
End Select
End Sub

Public Function UserGetBlockWithAtts(Optional sPrompt As String = _
"Select Attributed Block: ") As AcadBlockReference
'------------------------------------------------------------------------------
'
'
'------------------------------------------------------------------------------
Dim acObj As Object
Dim vPickPt As Variant
Dim sAtt As String
'''''''''''''''''''''''''''''''''''''''
On Error GoTo NOT_ENTITY

TRY_AGAIN:
ThisDrawing.Utility.GetEntity acObj, vPickPt, sPrompt
If acObj.ObjectName <> "AcDbBlockReference" Then
GoTo NOT_ENTITY
End If

If acObj.HasAttributes Then
Set UserGetBlockWithAtts = acObj
Else
MsgBox "This Block has no Attributes"
End If
Exit Function

NOT_ENTITY:
'If you click on space or do not select an entity, this error will be generated
If MsgBox("You have not selected a block with attributes.", vbOKCancel) = vbOK Then
Resume TRY_AGAIN
End If
End Function


Public Sub CopySameAttsFromBlkToBlk(ByVal vAtts1 As Variant, _
ByRef vAtts2 As Variant)
'------------------------------------------------------------------------------
'
'
'------------------------------------------------------------------------------
Dim l As Long
Dim m As Long
'''''''''''''''''''''''''''''''''''''''
For m = LBound(vAtts1) To UBound(vAtts1)
For l = LBound(vAtts2) To UBound(vAtts2)
If vAtts1(m).TagString = vAtts2(l).TagString Then
vAtts2(l).TextString = vAtts1(m).TextString
End If
Next l
Next m
End Sub

Snappy Tabby

Catchy title (don't you think? .. anyway). Just a quick reminder (one of our users asked the other day), if you use multiple osnap types but it seems AutoCad has this uncanny way of picking the one you do not want first, you can toggle through your osnaps with the TAB key. Like I said, Snappy Tabby.