Message 1 of 6
Select entity by lineweight
Not applicable
01-18-2008
12:47 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I have a macro that selects lines from a selectionset with certain properties and sets them to 'bylayer' then to a certain layer.
Sub SelHiddenLType()
Dim SS As AcadSelectionSet
Dim fType(2) As Integer
Dim fData(2) As Variant
Dim ssObject As AcadEntity
Dim Count As Integer
Set SS = SSDel("temp")
fType(0) = 0: fData(0) = "line"
fType(1) = 6: fData(1) = "Continuous"
fType(2) = 370: fData(2) = "50" 'this is not working
SS.Select acSelectionSetAll, , , fType, fData
MsgBox SS.Count & " hidden line(s) found"
For Each ssObject In SS
ssObject.Linetype = "BYLAYER"
ssObject.Lineweight = acLnWtByLayer
ssObject.color = acByLayer
ssObject.Layer = "__Contour"
Next ssObject
End Sub
Private Function SSDel(strName As String) As AcadSelectionSet
' Check Selection Set Name
Dim ObjSS As AcadSelectionSet
Dim objSSets As AcadSelectionSets
Set objSSets = ThisDrawing.SelectionSets
For Each ObjSS In objSSets
If ObjSS.Name = strName Then
objSSets.Item(strName).Delete
Exit For
End If
Next
Set ObjSS = objSSets.Add(strName)
Set SSDel = ObjSS
End Function
The problem is that fType(2) = 370: fData(2) = "50" does not detect 0.50 mm lineweight. I've tried changing fType to 371-379 and the fData to -1(ByLayer).
Can someone help?
Sub SelHiddenLType()
Dim SS As AcadSelectionSet
Dim fType(2) As Integer
Dim fData(2) As Variant
Dim ssObject As AcadEntity
Dim Count As Integer
Set SS = SSDel("temp")
fType(0) = 0: fData(0) = "line"
fType(1) = 6: fData(1) = "Continuous"
fType(2) = 370: fData(2) = "50" 'this is not working
SS.Select acSelectionSetAll, , , fType, fData
MsgBox SS.Count & " hidden line(s) found"
For Each ssObject In SS
ssObject.Linetype = "BYLAYER"
ssObject.Lineweight = acLnWtByLayer
ssObject.color = acByLayer
ssObject.Layer = "__Contour"
Next ssObject
End Sub
Private Function SSDel(strName As String) As AcadSelectionSet
' Check Selection Set Name
Dim ObjSS As AcadSelectionSet
Dim objSSets As AcadSelectionSets
Set objSSets = ThisDrawing.SelectionSets
For Each ObjSS In objSSets
If ObjSS.Name = strName Then
objSSets.Item(strName).Delete
Exit For
End If
Next
Set ObjSS = objSSets.Add(strName)
Set SSDel = ObjSS
End Function
The problem is that fType(2) = 370: fData(2) = "50" does not detect 0.50 mm lineweight. I've tried changing fType to 371-379 and the fData to -1(ByLayer).
Can someone help?