supressing wire numbers

[testsubject]

Hi all,

I am trying to change the wire layer format automatically (specifically turning OFF wire numbering) for several drawings I have. I am aware of the "Create/Edit Wire Type" but want to automate it using maybe a script. I did do a search but came up empty. Anyone try this yet??

Thanks,

Robert Hanrahan

[rhesusminus]

You'll have to create a program to achieve this. My investigation found that this setting resides in an xrecord in the actual layer.

So.. lisp/vba/.net... Go on 🙂

THL

[rhesusminus]

Since I was already on it.. here's some VBA code to set the Wire Numbering On/Off...

Option Explicit

Public Sub Test()

    Call SetLayerWireNumbering("WIRES", True)
    
End Sub

Public Sub SetLayerWireNumbering(ByVal LayerName As String, ByVal WireNumbering As Boolean)
    
    Dim Layer As AcadLayer
    Dim Dic As AcadDictionary
    Dim XRecord As AcadXRecord
    Dim XRTypes As Variant
    Dim XRValues As Variant
    
    ' Step through all layers
    For Each Layer In ThisDrawing.Layers
        
        ' If layer name matches the Layer to be changed...
        If StrComp(Layer.Name, LayerName, vbTextCompare) = 0 Then
            
            ' If layer has dictionary...
            If Layer.HasExtensionDictionary Then
                
                ' Get dictionary
                Set Dic = Layer.GetExtensionDictionary
                
                ' Get first XRecord in dictionary
                Set XRecord = Dic.Item(0)
                
                ' Get XRecord data
                Call XRecord.GetXRecordData(XRTypes, XRValues)
                
                ' Set "bit" for Wire Numbering
                If WireNumbering Then
                    XRValues(24) = 1
                Else
                    XRValues(24) = 0
                End If
                
                ' Write XRecord data
                Call XRecord.SetXRecordData(XRTypes, XRValues)
                
                ' Exit the layer loop
                Exit For
                
            End If ' If layer has extension dictionary...
        
        End If ' If layer name matches the Layer to be changed...
    
    Next ' Step through all layers
    
End Sub

Copy/Paste this into the THisDrawing module in the VBA editor, and experiment with the Test-subroutine.

This could also be implemented in a script if needed.

THL

[testsubject]

Thanks for the response! I will give this a try and let you know how it worked out.

Bob