Search the Community
Showing results for tags 'join polyline'.
-
Can anyone show me with an screencast how to create vb file & run the code Private Sub CommandButtonSmooth_Click() Dim sset As AcadSelectionSet Dim v(0) As Variant Dim lifiltertype(0) As Integer Dim plineObj As AcadLWPolyline Dim oLWP As AcadLWPolyline Dim i As Long Dim var As Variant Dim oSS() As AcadEntity Dim oGr As AcadGroup Set oGr = ThisDrawing.Groups.Add("QWERT") Set sset = Nothing For i = 0 To ThisDrawing.SelectionSets.Count - 1 Set sset = ThisDrawing.SelectionSets.Item(i) If sset.Name = "ss1" Then sset.Clear Exit For Else Set sset = Nothing End If Next i If sset Is Nothing Then Set sset = ThisDrawing.SelectionSets.Add("ss1") End If 'create a selection set of all the entities on a given layer 'here they are all lw polylines lifiltertype(0) = 8 v(0) = "jhl_9.25_begin" sset.Select acSelectionSetAll, , , lifiltertype, v ReDim Preserve oSS(0 To sset.Count - 1) As AcadEntity For i = 0 To sset.Count - 1 Set oSS(i) = sset.Item(i) Next i 'add plines to group oGr.AppendItems oSS Dim GRname As String GRname = oGr.Name ' using SendCommand method with Group ThisDrawing.SendCommand "_PEDIT" & vbCr & "M" & vbCr & "G" & vbCr & GRname & vbCr & vbCr & "J" & vbCr & "0.0" & vbCr & vbCr ' deleting group and clearing selection set oGr.Delete sset.Clear 'start to pedit spline or fit here Dim oGroup As AcadGroup Set oGroup = ThisDrawing.Groups.Add("ZERO") GRname = oGroup.Name 'select all the joined plines sset.Select acSelectionSetAll, , , lifiltertype, v ReDim Preserve oSS(0) As AcadEntity For i = 0 To sset.Count - 1 Set oLWP = sset.Item(i) Set oSS(0) = sset.Item(i) 'create group with one item oGroup.AppendItems oSS If oLWP.Closed Then 'Spline ThisDrawing.SendCommand "_PEDIT" & vbCr & "M" & vbCr & "G" & vbCr & GRname & vbCr & vbCr & "S" & vbCr & vbCr Else 'Fit ThisDrawing.SendCommand "_PEDIT" & vbCr & "M" & vbCr & "G" & vbCr & GRname & vbCr & vbCr & "F" & vbCr & vbCr End If 'remove the pline from the group oGroup.RemoveItems oSS Next i sset.Delete oGroup.Delete End Sub Approved VB code for Joining lwpolylines