klpocska Posted March 1, 2010 Posted March 1, 2010 I convert polylines to block with this code: Sub Pline2Block() Dim objBlock As AcadBlock Dim oPline As AcadLWPolyline Dim varPt As Variant Dim Cordinat As Variant Dim UpperBoundery As Integer Dim LowerBoundery As Integer Dim objBlockName As String Dim Scf As Double ThisDrawing.Utility.GetEntity oPline, varPt, "Select polyline" Cordinat = oPline.Coordinates UpperBoundery = UBound(Cordinat) LowerBoundery = LBound(Cordinat) Do If l > UpperBoundery Then Exit Do End If l = l + 1 Loop With ThisDrawing.Utility .InitializeUserInput 1 objBlockName = .GetString(True, vbCr & "Enter block name: ") End With Set objBlock = ThisDrawing.Blocks.Add(varPt, objBlockName) objBlock.AddLightWeightPolyline Cordinat Scf = 1 ThisDrawing.ModelSpace.InsertBlock varPt, objBlockName, Scf, Scf, Scf, 0 oPline.Delete End Sub And I want to add automatic sequence number for the blockname with VBA What should i do ? Quote
fixo Posted March 1, 2010 Posted March 1, 2010 I convert polylines to block with this code: Sub Pline2Block() Dim objBlock As AcadBlock Dim oPline As AcadLWPolyline Dim varPt As Variant Dim Cordinat As Variant Dim UpperBoundery As Integer Dim LowerBoundery As Integer Dim objBlockName As String Dim Scf As Double ThisDrawing.Utility.GetEntity oPline, varPt, "Select polyline" Cordinat = oPline.Coordinates UpperBoundery = UBound(Cordinat) LowerBoundery = LBound(Cordinat) Do If l > UpperBoundery Then Exit Do End If l = l + 1 Loop With ThisDrawing.Utility .InitializeUserInput 1 objBlockName = .GetString(True, vbCr & "Enter block name: ") End With Set objBlock = ThisDrawing.Blocks.Add(varPt, objBlockName) objBlock.AddLightWeightPolyline Cordinat Scf = 1 ThisDrawing.ModelSpace.InsertBlock varPt, objBlockName, Scf, Scf, Scf, 0 oPline.Delete End Sub And I want to add automatic sequence number for the blockname with VBA What should i do ? I already have the similar one in my code collection just I have edited them slightly with your variable names only Option Explicit '' based on LoopExample code written by Tony Tanzillo '' request check "Break on Unhandled Errors" in General options Sub Pline2Block() Dim objBlock As AcadBlock Dim oEnt As AcadEntity Dim oPline As AcadLWPolyline Dim copyPline As AcadLWPolyline Dim varPt As Variant Dim objBlockName As String Dim headBlockName As String Dim Scf As Double Dim inc As Integer Dim plineCopy(0) As AcadEntity ThisDrawing.Utility.GetEntity oEnt, varPt, "Select polyline" If TypeOf oEnt Is AcadLWPolyline Then Set oPline = oEnt Set plineCopy(0) = oEnt Else MsgBox "Selected is not a polyline. Program exiting..." Exit Sub End If With ThisDrawing.Utility .InitializeUserInput 1 headBlockName = .GetString(True, vbCr & "Enter block name: ") End With inc = 1 Scf = 1 Dim Msg As String Msg = vbCrLf & "Next point or ENTER to exit: " Dim MyPoint As Variant Do On Error Resume Next If inc > 1 Then MyPoint = ThisDrawing.Utility.GetPoint(, Msg) If Err Then Err.Clear Exit Do End If On Error GoTo 0 End If objBlockName = headBlockName & CStr(inc) Set objBlock = ThisDrawing.Blocks.Add(varPt, objBlockName) ThisDrawing.copyObjects plineCopy, objBlock If inc = 1 Then MyPoint = varPt ThisDrawing.ModelSpace.InsertBlock MyPoint, objBlockName, Scf, Scf, Scf, 0 inc = inc + 1 Loop On Error GoTo 0 oPline.Delete MsgBox "Created " & inc - 1 & " blocks." End Sub ~'J'~ Quote
klpocska Posted March 1, 2010 Author Posted March 1, 2010 thx, but I have a lot of different polylines I want to convert each polylines with same block name, only the sequence number is different. ( Example : line1 line2 line ... etc... ) And What should when the sequence number is already exist? How to do it? Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.