Convert to block VBA

Hi All!

How to convert an existing polyline to a (internal) block with VBA?

Here's a quick LISP to convert Objects to Blocks:

(defun c:obj2blk (/ ss bNme i pt ent)
 ;; Lee Mac  ~  11.02.10

 (cond (  (not (setq ss (ssget '((-4 . "<NOT") (0 . "INSERT,POLYLINE,VIEWPORT") (-4 . "NOT>"))))))

       (  (while
            (progn
              (setq bNme (getstring t "\nSpecify Block Name: "))

              (cond (  (not (snvalid bNme))
                       (princ "\n** Invalid Block Name **"))

                    (  (tblsearch "BLOCK" bNme)
                       (princ "\n** Block Already Exists **"))))))

       (  (not (setq i -1 pt (getpoint "\nSpecify Base Point: "))))

       (t (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bNme) (cons 70 0)))

          (while (setq ent (ssname ss (setq i (1+ i))))
            (entmake (entget ent))
            (entdel ent))

          (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))
          (entmake (list (cons 0 "INSERT") (cons 2 bNme) (cons 10 pt)))))

 (princ))

Super, but it isn't good for me... only VBA...

One sequence of events could be:

1. Create a new (empty initially) Block with the appropriate name and insertion point.

2. Use the CopyObjects method (see Developer Documentation – ActiveX and VBA Reference – Methods – CopyObjects): Where “Object” is the database where the poly currently resides (ModelSpace, Layout Block, etc.), “Objects” would be a variant array holding the poly, “Owner” would be the Block created in the step 1.

3. Insert a Block Reference to that Block into the appropriate space.

4. Delete initial Polyline, if needed.

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

Sic?

That would be another sequence of events for a LWPoly to BlockRef conversion - nicely done.

To accommodate any type of LWPoly, though, the Bulge factors and Open/Close properties should be addressed.