[求助]：插入无名块的程序,错在哪?

long123sp

Sub Example_InsertBlock()
    ' This example creates a block containing a circle.
    ' It then inserts the block
    ' Create the block
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "*u")
    ' Add a circle to the block
    Dim circleObj As AcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
    center(0) = 0: center(1) = 0: center(2) = 0
    radius = 1
    Set circleObj = blockObj.AddCircle(center, radius)
    ' This example creates an attribute definition in model space.
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insertionPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    ' Define the attribute definition
    height = 1#
    mode = acAttributeModeVerify
    prompt = "New Prompt"
    insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0
    tag = "New Tag"
    value = "New Value"
    ' Create the attribute definition object in model space
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value)
    ' Insert the block
    Dim i As Long
    i = 0&
    Dim scaX As Double
    Dim scaY As Double
    Dim scaZ As Double
    scaX = 1#
    scaY = 1#
    scaZ = 1#
    Dim strname As String
    Dim strname1 As String
    Dim blockRefObj As AcadBlockReference
    For i = 1& To 10&
    scaX = scaX + i
    scaY = scaY + i
    scaZ = scaZ + i
    strname1 = Format(i, "")
    strname = "*u"
    MsgBox strname1
    strname = strname + strname1
    MsgBox strname
    insertionPnt(0) = 2# + i
    insertionPnt(1) = 2# + i
    insertionPnt(2) = 0#
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, strname, scaX, scaY, scaZ, 0)
    Next i
    ZoomAll
End Sub

AyungerStudio

;;;*************************
;;; No.11 生成无名图块      
;;;*************************
(defun MakeUnNameBlock(xSS / count entlist ent Blk retBlk)
        (setq ss xSS)
  (entmake '((0 . "BLOCK") (2 . "*U") (70 . 1) (10 0 0 0)))
  (setq count 0)
  (repeat (sslength ss)
    (setq entlist(entget(setq ent(ssname ss  count))))
    (setq count (1+ count))
    (entmake entlist)
  );end_repeat
  (setq count 0)
  (repeat(sslength ss)
    (setq ent(ssname ss count))
    (setq count (1+ count))
    (entdel ent)
  );end_repeat
  (setq Blk(entmake '((0 . "ENDBLK"))))
  (if (princ Blk)
          (entmake (list (cons 0  "INSERT") (cons 2 Blk) (cons 10 '(0 0 0))))
  );end_if
  (setq retBlk Blk)
);end_defun

该函数是生成无名块的正确函数，至于插入等问题嘛，看参Command Help喽！！
当然你采用的是VB，我的用意是给你无名块创建的过程及元素！

雪山飞狐(lzh)

strname = "*u"
改为
strname = blockObj.name

long123sp

谢谢楼上两位，我的本意是要创建从*U1至*U10的不同的无名块,像INTECAD中的材料明细表一样的。而本程序运行时每次只能（依次）创建一个无名块，然后出现“运行时错误‘2147418113（8000FFFF）’；方法‘Insertblock’作用于‘IAcadmodelspace’时失败”后退出。就是第一次运行时创建*U1后出错退出，第二次运行时创建*U1，*U2后退出，第三次创建*U1，*U2，*U3.....