Jump to content

Recommended Posts

Posted

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 ?

Posted
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'~

Posted

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?

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...