将对象复制到新dwg

haustab · 发表于 2022-7-6 12:05:52

如何将对象复制到新的dwg或更好的dwg？

 
(defun c:copybypick (/ *acad* doc path tgdbxdoc pck vlobj)
 (setq *acad* (vlax-get-acad-object)
doc    (vla-get-documents *acad*)
 )
 (setq path (getfiled "Select Source File"
        (getvar "dwgprefix")
        "dwg;dwt;dws"
        0
     )
 )
 (setq tgdbxdoc
 (vla-GetInterfaceObject *acad* "ObjectDBX.AxDbDocument.17")
 )
 (vla-open tgdbxdoc path)
 (setq pck   (entsel "Select object: ")
vlobj (vlax-ename->vla-object (car pck))
 )
 ;;;(vla-copyobjects tgdbxdoc vloobj);;;
 (vlax-release-object tgdbxdoc)
 (princ)
)

gile · 发表于 2022-7-6 12:12:00

你好

查看开发者帮助>ActiveX和VBA参考中的CopyObjects方法

vla CopyObjects至少需要3个参数：
-源数据库或文档（您案例中的文档）
-包含要复制的vla对象的变体（safearray）
-目标文档（tgdbxdoc）

对于第二个参数，您必须构建如下安全阵列：

或者，使用“旧式”vlax调用（避免生成saarray）更简单：

copy

(vlax-invoke doc 'CopyObjects (list vlobj) tgdbxdoc)

devitg · 发表于 2022-7-6 12:17:07

嗨，吉尔，我犯了这个错误
; 错误：ActiveX服务器返回错误：未知名称：“COPYOBJECTS”

我添加（VL-LOAD-COM）

haustab · 发表于 2022-7-6 12:19:06

嗨，吉尔，
感谢重播。
如果我在我的行中使用你的代码，我会出错！？
我用过（vlax invoke doc’CopyObjects（list vlobj）tgdbxdoc）
而不是（vla copyobjects。。。
错误在哪里？

Lee Mac · 发表于 2022-7-6 12:22:35

例子：

copy


(defun Copy_Obj (ss blk / ObjLst)
 (vl-load-com)
 (setq ObjLst
   (mapcar 'vlax-ename->vla-object
     (vl-remove-if 'listp
       (mapcar 'cadr (ssnamex ss)))))
 (cond (  (vl-every '= (mapcar 'vla-get-OwnerId ObjLst))
          (vla-copyobjects             
            (vla-get-ActiveDocument
              (vlax-get-acad-object))
            (vlax-make-variant
              (vlax-safearray-fill
                (vlax-make-safearray
                  vlax-vbObject
                    (cons 0 (1- (length ObjLst)))) ObjLst)) blk))))

ss=选择集
blk=目标块（文档变量/块定义）

gile · 发表于 2022-7-6 12:28:13

抱歉，它看起来像（vlax invoke…）语句不适用于AxDbDocument（它适用于活动文档内的块。

因此，请使用（vlax make variant…）方法

haustab · 发表于 2022-7-6 12:33:28

你好
感谢重播
李，我用（ssget）得到ss=SelectionSet，但是blk=tgdbxdoc（从我的行中）是吗？
我不确定我是否完全理解。。。
如何使用（Copy_Obj ss blk），而参数的类型是ss和blk？
@李，我看过你的其他项目，做得很好，顶。

Lee Mac · 发表于 2022-7-6 12:37:24

您好，Haustab，

谢谢你的夸奖，非常感谢。

是的，blk是新文档，在您的案例中是tgdbxdoc：眨眼：

Lee Mac · 发表于 2022-7-6 12:41:04

Gile这能行吗？

copy


(defun c:test (/ Copy_obj ss path app docs doc)
 (vl-load-com)
 (defun Copy_Obj (ss blk / ObjLst)
   (vl-load-com)
   (setq ObjLst
     (mapcar 'vlax-ename->vla-object
       (vl-remove-if 'listp
         (mapcar 'cadr (ssnamex ss)))))
   (cond (  (vl-every '= (mapcar 'vla-get-OwnerId ObjLst))
            (vla-copyobjects             
              (vla-get-ActiveDocument
                (vlax-get-acad-object))
              (vlax-make-variant
                (vlax-safearray-fill
                  (vlax-make-safearray
                    vlax-vbObject
                      (cons 0 (1- (length ObjLst)))) ObjLst)) blk))))
 (if (and (setq ss (ssget))
          (setq path (getfiled "File" "" "dwg" 16)))
   (progn
     (setq app (vlax-create-object
                 (strcat "AutoCAD.Application."
                   (itoa (fix (atof (getvar 'ACADVER)))))))
     (vlax-put-property app 'Visible :vlax-true)
       (vlax-put-property
         (vla-get-Display
           (vla-get-preferences app)) 'maxautocadwindow :vlax-true)
 
     (setq docs (vla-get-documents app) doc (vla-open docs path :vlax-false))
     (Copy_obj ss doc)
     (vla-save doc)
     (vla-close doc)
     (vlax-invoke-method app 'quit)
     (mapcar
       (function
         (lambda (x)
           (vlax-release-object x))) (list app docs doc))))
 (princ))

haustab · 发表于 2022-7-6 12:43:24

嗨，李，
我不知道。。。
错误
复制到其他图形中似乎不那么容易。
你的最后一个代码也是一个错误。但是有很多东西需要我学习
谢谢

[编程交流] 将对象复制到新dwg

发表回复

精选推荐