社区 › Auto Lisp › 将对象复制到新dwg

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

将对象复制到新dwg

如何将对象复制到新的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）更简单：
 
(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

例子：
 

(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这能行吗？
 

(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