[求助]把外部参照变成插入块

xiaoquansb

在网上有段代码，可以把全部的外部参照全部插入或者绑定

由于绑定回弄出好多图层，所以我改了一下，只能全部插入

但是我只想要插入我选中的那个外部参照，竟然不会改，

实在对这个"Object" 无办法，试了N次都出错，只好上来求教了

请帮我改一改，使之能够只插入选中的外部参照，谢谢

(defun C:ii ( / inskey lst)
  (setq inskey "T")
  (setq inskey (if inskey :vlax-true :vlax-false))
  (setq *doc (vla-get-activedocument(vlax-get-acad-object)))
  (vlax-for x (vla-get-blocks *doc)
    (if (= :vlax-true (vla-get-isxref x))
      (setq lst(cons x lst))
    )
  )
  (mapcar (FUNCTION (LAMBDA(x)(vla-bind x inskey)))lst)
)

xiaojinwen

(DEFUN C:II (/ INSKEY LST *DOC NAMELST X I J STRING)
      (SETQ *DOC (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
      (SETQ J 0 )
      (WHILE J
     (SETQ I 0
    STRING ""
    LST NIL
    NAMELST NIL
     ) ;_ 结束SETQ
     (VLAX-FOR X (VLA-GET-BLOCKS *DOC)
    (IF (= :VLAX-TRUE (VLA-GET-ISXREF X))
   (SETQ LST     (CONS X LST)
         NAMELST (CONS (VLA-GET-NAME X) NAMELST)
   ) ;_ 结束SETQ
    ) ;_ 结束if
     ) ;_ 结束vlax-for
     (IF LST
    (PROGN
   (TEXTSCR)
   (PRINC "\n序号        参照块名称")
   (FOREACH STR NAMELST
         (SETQ STRING (STRCAT "    " (ITOA I) "        " STRING STR "\n")
        I    (1+ I)
         ) ;_ 结束SETQ
   ) ;_ 结束FOREACH
   (PRINC (STRCAT "\n" STRING))
   (IF (< (SETQ J (GETINT "\n选择要绑定的参照块名称的序号：")) (LENGTH LST))
         (VLA-BIND (NTH J LST) :VLAX-TRUE)
         (PROGN
        (SETQ J NIL)
        (VL-EXIT-WITH-ERROR "\n 你输入的编号超出范围。" )
         ) ;_ 结束PROGN
   ) ;_ 结束IF
    ) ;_ 结束PROGN
  (SETQ J NIL)
     ) ;_ 结束IF
      ) ;_ 结束WHILE
      (PRINC)
) ;_ 结束defun

xiaojinwen

;;这个是屏幕鼠标选择的

(DEFUN C:XREFBIND (/ ACADDOCUMENT CATCH OBJNAME SSOBJ TMP REFBLOCK)                                   (SETQ  ACADDOCUMENT (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
      (SETQ SSOBJ (VLA-GET-ACTIVESELECTIONSET ACADDOCUMENT))
      (VLA-CLEAR SSOBJ)
      (PRINC "\n选择要绑定的参照块:")
      (VLA-SELECTONSCREEN SSOBJ
     (VLAX-MAKE-VARIANT (XET-LIST->SAFEARRAY (LIST 100) VLAX-VBINTEGER))
     (VLAX-MAKE-VARIANT (XET-LIST->SAFEARRAY (LIST "AcDbBlockReference") VLAX-VBVARIANT))
      ) ;_ 结束VLA-SELECTONSCREEN(SETQ I(VLA-ITEM SSOBJ 0) TMP NIL)
      (WHILE (< 0 (SETQ CATCH (VLA-GET-COUNT SSOBJ)))
     (SETQ TMP NIL)
     (VLAX-FOR I SSOBJ
    (SETQ OBJNAME (VLA-GET-EFFECTIVENAME I))
    (IF (= :VLAX-TRUE (VLA-GET-ISXREF (SETQ REFBLOCK (VLA-ITEM (VLA-GET-BLOCKS ACADDOCUMENT) OBJNAME))))
   (IF (NOT (MEMBER OBJNAME TMP))
         (PROGN
        (SETQ TMP (CONS OBJNAME TMP))
        (VLA-BIND REFBLOCK :VLAX-TRUE)
        (PRINC (STRCAT "\n 参照块：" OBJNAME " 已经绑定。"))
         ) ;_ 结束PROGN
   ) ;_ 结束IF
    ) ;_ 结束IF
     ) ;_ 结束VLAX-FOR
     (VLA-CLEAR SSOBJ)
     (PRINC "\n选择要绑定的参照块:")
     (VLA-SELECTONSCREEN SSOBJ
    (VLAX-MAKE-VARIANT (XET-LIST->SAFEARRAY (LIST 100) VLAX-VBINTEGER))
    (VLAX-MAKE-VARIANT (XET-LIST->SAFEARRAY (LIST "AcDbBlockReference") VLAX-VBVARIANT))
     ) ;_ 结束VLA-SELECTONSCREEN
      ) ;_ 结束WHILE
) ;_ 结束defun

(DEFUN XET-LIST->SAFEARRAY (LISTA VBDATASTYLE / LL)
      ;;将列表转换为VLA数组对象 需指定对象类型
      ;;(SETQ LISTA (LIST 0 0 0 "AA" 0.001))
      (SETQ LL (- (LENGTH LISTA) 1)
     LL (CONS 0 LL)
      ) ;_ 结束SETQ
      (SETQ LL (VLAX-MAKE-SAFEARRAY VBDATASTYLE LL))
      (VLAX-SAFEARRAY-FILL LL LISTA)
)

xiaoquansb

多谢jinwen兄，不过不知为什么运行时返回下面的信息的，是不是我cad有什么问题呢

错误: no function definition: VLAX-GET-ACAD-OBJECT

xiaoquansb

真的是呢，我运行其他的也会出现这段信息，真郁闷，有人知道这是怎么回事吗

ZZXXQQ

加一句(vl-load-com)试试。

xiaoquansb

神奇之极加了(vl-load-com)后，程序可以运行了

不过又出现了下面的错误信息

还要加载什么吗 ？

error: ActiveX Server returned the error: unknown name: EffectiveName

xiaojinwen

语法

object.EffectiveName

object

BlockRef, MInsertBlock
使用该属性的对象。

EffectiveName

String[字符串]; 只读

说明

原始名称是用户在用户界面中看到的块的名称。动态块可将其用匿名块来绘制，而其名称将与用户在用户界面中看到的块的名称不同。Name 属性返回的是用于绘制参照的块的名称，而 EffectiveName 是用户查看参照的名称。

注意 要访问该属性，可使用 IAcadBlockReference2 或 IAcadMInsertBlock2 接口。

错误原因是:

           未加载IAcadBlockReference2 接口或者 对象不支持 EFFECTIVENAME 属性，可能选了不包含EFFECTIVENAME 属性的块对象。按道理是不存在这种情况的。

由于这里的代码都有调用VL函数，所以你的函数库文件的第一行应该有

(VL-LOAD-COM)

我默认你的文件有此项内容，这里的代码，粘贴进去，重新加载后即可执行。

你加载下面的命令，在命令行输入DUMP 选择你之前使程序出错的外部参照块，会出现外部参照块的所有支持的方法和属性，把返回结果贴上来

(DEFUN C:DUMP (/ ENT)
      (IF (= (TYPE (SETQ ENT (ENTSEL))) 'LIST)
           (PROGN
                  (VLAX-DUMP-OBJECT (VLAX-ENAME->VLA-OBJECT (CAR ENT)) T)
                 (TEXTSCR)
               ) ;_ 结束PROGN
      ) ;_ 结束IF
) ;_ 结束DEFUN

我们一起来研究下。

xiaoquansb

好的

不过还是要加上(vl-load-com)才能运行

是不是说cad启动的时候，少加载了什么，我用的是06，中英文版也是这样的情况

Command: dump
Select object: ; error: no function definition: VLAX-ENAME->VLA-OBJECT

运行后返回信息如下

Customization file loaded successfully. Customization Group: ACAD
Customization file loaded successfully. Customization Group: CUSTOM
Regenerating model.
AutoCAD menu utilities loaded.*Cancel*
Command: COMMANDLINE
Command: xa
XATTACH
Attach Xref "E02": D:\JOB\BD\BD\1217\E02.dwg
"E02" loaded.
Specify insertion point or [Scale/X/Y/Z/Rotate/PScale/PX/PY/PZ/PRotate]:
Command: z
ZOOM
Specify corner of window, enter a scale factor (nX or nXP), or
[All/Center/Dynamic/Extents/Previous/Scale/Window/Object] <real time>: e
Regenerating model.
Command: ap
APPLOAD 新建 文本文档.lsp successfully loaded.
Command:
Command:
Command: dump
Select object: ; error: no function definition: VLAX-ENAME->VLA-OBJECT
Command:
Command: ap
APPLOAD 新建 文本文档.lsp successfully loaded.
Command:
Command:
Command: ap
APPLOAD 新建 文本文档.lsp successfully loaded.
Command:
Command:
Command: dump
Select object: ; IAcadExternalReference2: IAcadExternalReference Interface
; Property values:
;   Application (RO) = #<VLA-OBJECT IAcadApplication 00c2db8c>
;   Document (RO) = #<VLA-OBJECT IAcadDocument 013d7344>
;   Handle (RO) = "116"
;   HasAttributes (RO) = 0
;   HasExtensionDictionary (RO) = 0
;   Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 0a99d1a4>
;   InsertionPoint = (936.412 386.14 0.0)
;   InsUnits (RO) = "Unitless"
;   InsUnitsFactor (RO) = 1.0
;   Layer = "0"
;   Linetype = "ByLayer"
;   LinetypeScale = 1.0
;   Lineweight = -1
;   Name = "E02"
;   Normal = (0.0 0.0 1.0)
;   ObjectID (RO) = 2130174256
;   ObjectName (RO) = "AcDbBlockReference"
;   OwnerID (RO) = 2130042104
;   Path = "D:\\JOB\\BD\\BD\\1217\\E02.dwg"
;   PlotStyleName = "ByLayer"
;   Rotation = 0.0
;   TrueColor = #<VLA-OBJECT IAcadAcCmColor 0a9acf40>
;   Visible = -1
;   XEffectiveScaleFactor = 1.0
;   XScaleFactor = 1.0
;   YEffectiveScaleFactor = 1.0
;   YScaleFactor = 1.0
;   ZEffectiveScaleFactor = 1.0
;   ZScaleFactor = 1.0
; Methods supported:
;   ArrayPolar (3)
;   ArrayRectangular (6)
;   Copy ()
;   Delete ()
;   Explode ()
;   GetAttributes ()
;   GetBoundingBox (2)
;   GetConstantAttributes ()
;   GetExtensionDictionary ()
;   GetXData (3)
;   Highlight (1)
;   IntersectWith (2)
;   Mirror (2)
;   Mirror3D (3)
;   Move (2)
;   Rotate (2)
;   Rotate3D (3)
;   ScaleEntity (2)
;   SetXData (2)
;   TransformBy (1)
;   Update ()
nil
Command:
Command:
Automatic save to C:\Documents and Settings\BOAT\Local
Settings\Temp\Drawing1_1_1_8961.sv$ ...

xiaojinwen

我看了上面的关于英文版的BLOCK 对象方法、属性列表

这个问题属于应该版本的问题

中文版的04都有 EFFECTIVENAME 属性啊。偏偏你传上来的没有。

命令: DUMP
选择对象: ; IAcadExternalReference: IAcadExternalReference 接口
;特性值:
;   Application (RO) = #<VLA-OBJECT IAcadApplication 00d73d3c>
;   Document (RO) = #<VLA-OBJECT IAcadDocument 01baf398>
;   EffectiveName (RO) = "TEST"
;   Handle (RO) = "B74"
;   HasAttributes (RO) = 0
;   HasExtensionDictionary (RO) = 0
;   Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 092e025c>
;   InsertionPoint = (49.3608 1482.46 0.0)
;   InsUnits (RO) = "毫米"
;   InsUnitsFactor (RO) = 1.0
;   IsDynamicBlock (RO) = 0
;   Layer = "0"
;   Linetype = "ByLayer"
;   LinetypeScale = 1.0
;   Lineweight = -1
;   Material = "ByLayer"
;   Name = "TEST"
;   Normal = (0.0 0.0 1.0)
;   ObjectID (RO) = 2128230112
;   ObjectName (RO) = "AcDbBlockReference"
;   OwnerID (RO) = 2130271480
;   Path = "D:\\TEST.DWG"
;   PlotStyleName = "ByLayer"
;   Rotation = 0.0
;   TrueColor = #<VLA-OBJECT IAcadAcCmColor 08b35e10>
;   Visible = -1
;   XEffectiveScaleFactor = 1.0
;   XScaleFactor = 1.0
;   YEffectiveScaleFactor = 1.0
;   YScaleFactor = 1.0
;   ZEffectiveScaleFactor = 1.0
;   ZScaleFactor = 1.0
;支持的方法:
;   ArrayPolar (3)
;   ArrayRectangular (6)
;   ConvertToAnonymousBlock ()
;   ConvertToStaticBlock (1)
;   Copy ()
;   Delete ()
;   Explode ()
;   GetAttributes ()
;   GetBoundingBox (2)
;   GetConstantAttributes ()
;   GetDynamicBlockProperties ()
;   GetExtensionDictionary ()
;   GetXData (3)
;   Highlight (1)
;   IntersectWith (2)
;   Mirror (2)
;   Mirror3D (3)
;   Move (2)
;   ResetBlock ()
;   Rotate (2)
;   Rotate3D (3)
;   ScaleEntity (2)
;   SetXData (2)
;   TransformBy (1)
;   Update ()
nil

我把源代码该了下，应该能通吃：

(VL-LOAD-COM)

(DEFUN C:XREFBIND (/ COUNT CATCH OBJNAME SSOBJ TMP REFBLOCK)
      (SETQ ACADDOCUMENT (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
      (SETQ SSOBJ (VLA-GET-ACTIVESELECTIONSET ACADDOCUMENT))
      (VLA-CLEAR SSOBJ)
      (PRINC "\n选择要绑定的参照块:")
      (VLA-SELECTONSCREEN SSOBJ
     (VLAX-MAKE-VARIANT (XET-LIST->SAFEARRAY (LIST 100) VLAX-VBINTEGER))
     (VLAX-MAKE-VARIANT (XET-LIST->SAFEARRAY (LIST "AcDbBlockReference") VLAX-VBVARIANT))
      ) ;_ 结束VLA-SELECTONSCREEN(SETQ I(VLA-ITEM SSOBJ 0) TMP NIL)
      (WHILE (< 0 (SETQ COUNT (VLA-GET-COUNT SSOBJ)))
     (SETQ TMP NIL)
     (VLAX-FOR I SSOBJ
    (IF(VL-CATCH-ALL-ERROR-P(SETQ CATCH (vl-catch-all-apply 'VLA-GET-EFFECTIVENAME (list I))))
       (SETQ CATCH (VLA-GET-NAME I))

;如果对象不支持 VLA-GET-EFFECTIVENAME 则直接读取 NAME属性
       )
    (IF (= :VLAX-TRUE (VLA-GET-ISXREF (SETQ REFBLOCK (VLA-ITEM (VLA-GET-BLOCKS ACADDOCUMENT) CATCH))))
   (IF (NOT (MEMBER CATCH TMP))
         (PROGN
        (SETQ TMP (CONS CATCH TMP))
        (VLA-BIND REFBLOCK :VLAX-TRUE)
        (PRINC (STRCAT "\n 参照块：" CATCH " 已经绑定。"))
         ) ;_ 结束PROGN
   ) ;_ 结束IF
    ) ;_ 结束IF
     ) ;_ 结束VLAX-FOR
     (VLA-CLEAR SSOBJ)
     (PRINC "\n选择要绑定的参照块:")
     (VLA-SELECTONSCREEN SSOBJ
    (VLAX-MAKE-VARIANT (XET-LIST->SAFEARRAY (LIST 100) VLAX-VBINTEGER))
    (VLAX-MAKE-VARIANT (XET-LIST->SAFEARRAY (LIST "AcDbBlockReference") VLAX-VBVARIANT))
     ) ;_ 结束VLA-SELECTONSCREEN
      ) ;_ 结束WHILE
) ;_ 结束defun

(DEFUN XET-LIST->SAFEARRAY (LISTA VBDATASTYLE / LL)
      ;;将列表转换为VLA数组对象 需指定对象类型
      ;;(SETQ LISTA (LIST 0 0 0 "AA" 0.001))
      (SETQ LL (- (LENGTH LISTA) 1)
     LL (CONS 0 LL)
      ) ;_ 结束SETQ
      (SETQ LL (VLAX-MAKE-SAFEARRAY VBDATASTYLE LL))
      (VLAX-SAFEARRAY-FILL LL LISTA)
)