topic Re: Select entity by lineweight in VBA Forum

Select entity by lineweight

Anonymous — Fri, 18 Jan 2008 08:47:17 GMT

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?

Re: Select entity by lineweight

Anonymous — Sat, 19 Jan 2008 22:48:32 GMT

The value for dxf code 370 must be integer:
fType(2) = 370: fData(2) = 50
or use AutoCAD VBA enum (see Lineweight property
in the Help file)

~'J'~

Re: Select entity by lineweight

Anonymous — Tue, 29 Jan 2008 11:29:07 GMT

Thanks for you're reply, but both 50 and acLnWt050 do not work! any other suggestions?

Re: Select entity by lineweight

Anonymous — Wed, 30 Jan 2008 12:38:23 GMT

Sorry for the belating,
Yes, you're right, I 'm wrong
Here is an ugly and dirty method to select
all objects entire drawing with using of Lisp
expression in SendCommand (I don't like it)

Option Explicit

Public Sub SelectByLwt()

Dim ss As AcadSelectionSet
On Error GoTo Err_Control
Dim lwt As String
lwt = InputBox(vbCr & "Enter lineweight value" & vbCr & _
"[ as integer number only ]" & vbCr & _
"Or press Enter to set default", "Select by lineweight", "53")
With ThisDrawing
While .SelectionSets.Count > 0
.SelectionSets.item(0).Delete
Wend
' lisp expression to select all objects with this lineweight entire drawing
.SendCommand "(SSGET " & Chr(34) & "X" & Chr(34) & " (list (cons 370 " & lwt & ")))" & vbCr
Set ss = .ActiveSelectionSet
End With

MsgBox "Selected: " & ss.Count & " objects"

Dim ent As AcadEntity
For Each ent In ss
On Error Resume Next
ent.color = acYellow
Next

Err_Control:
If Not Err = 0 Then
MsgBox Err.Description
Err.Clear
End If

End Sub

~'J'~

Re: Select entity by lineweight

Anonymous — Thu, 31 Jan 2008 17:57:09 GMT

Rather than use lineweight as a selection filter test for it within the loop:

Sub SelHiddenLType()

Dim SS As AcadSelectionSet
Dim fType(1) As Integer
Dim fData(1) 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
If Not ssObject.Lineweight = acLnWt050 Then GoTo skipme
ssObject.Linetype = "BYLAYER"
ssObject.Lineweight = acLnWtByLayer
ssObject.color = acByLayer
ssObject.Layer = "__Contour"
skipme:
Next ssObject

End Sub

Re: Select entity by lineweight

Anonymous — Fri, 01 Feb 2008 11:19:54 GMT

That worked, thanks!