请教有关lisp中新建dwg的问题

SWAYWOOD

各位大侠，能不能用LISP实现这样一个过程
将一个图中的部分内容COPY到一个新建的图中，然后命名存盘该新图
注：新建图，粘贴，命名图，存盘退出都是通过程序
有可能实现吗？

雅明

可以的，可用SCR脚本文件方式，部分内容可用SSGET选择，COPY用WBLOCK命令直接写出，图档名你自己用对话框处理。
我以前写过的，但一次硬盘错格，全没了，不然给你发一份源代码。不过上述零散的陈述相信对你有所帮助的。

meflying

(defun c:test(/ app docs doc objects ss i n sslist)
  (setq app (vlax-get-acad-object))
  (setq doc (vla-get-activedocument app))
  (setq docs (vla-get-documents app))
  (setq ss (ssget))
  (setq n (sslength ss)
        i 0)
  (repeat n
    (setq sslist (append sslist (list (vlax-ename->vla-object (ssname ss i)))))
    (setq i (1+ i))
  )
  (setq objects (vlax-make-safearray vlax-vbObject (cons 0  (1- n))))
  (vlax-safearray-fill objects sslist)
  (setq doc_new (vla-add docs "acad.dwt"))
  (vla-copyobjects doc objects (vla-get-modelspace doc_new))
  (vla-saveas doc_new "e:\\drawing.dwg")
  (vla-close doc_new)
  (princ)
)

SWAYWOOD

多谢二位！

wkaii

直接调用 wblock 不就行了？

meflying

拷过去的不一定要做成块。。。

BDYCAD

to:  Meflying :
         我要處理很多圖檔想用程序來實現,  我現在想用你這個程序這樣做:
  (defun c:tet()
  (setq el  "L000000.dwg")
  (setq te (substr el 2 6))
  (setq tee (strlen te))
  (repeat 3000 ; 循環三仟次,因可處理的文件以有L02****.dwg的
    (setq n (atoi te))
    (setq nn (1+ n))
    (setq nnn(itoa nn))
    (setq nnnn(strlen nnn))
    (repeat (- tee nnnn) (setq nnn (strcat "0" nnn)))
    (setq tet(strcat (substr el 1 1)nnn ".dwg"))
    (if (findfile tet);如果在添加的支持找到該文件
      (progn
        (打開這個圖的程序);;不懂
        (explode-all);把全部的塊炸開,
        (command "purge" "b" "" "n");可以清除所有的塊了
        (command ".Qsave" ".close")));;結束存盤退出
    (setq te nnn))
  (princ))
;---------------------------------------------
(defun explode-all(/ all sl n sd);炸開所有圖塊, 但不得清除.
  (setvar "cmdecho" 0)
  (repeat 2
  (setq all(ssget "x")        sl (sslength all) n 0)
  (repeat sl
    (setq sd (cdr (assoc 0 (entget (ssname all n)))))
    (if (= sd "INSERT")
      (command ".explode" (ssname all n)))
    (setq n (1+ n))))
  (setvar "cmdecho" 1)
  (princ))

;; 我還不能做到. 請你幫幫助, 謝謝了!

龙龙仔

;;BDYCAD:還是老話
;;我發了不少批量處理範例,看來沒有幾人看懂如何使用!!(非objectdbx)
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=11324

meflying

BDYCAD发表于2003-12-25 11:21:00to:  Meflying :
          我要處理很多圖檔想用程序來實現,  我現在想用你這個程序這樣做:
   (defun c:tet()
   (setq el  "L000000.dwg")
   (setq te (substr el 2 6))
  

首先你的这个做法是不行的，打开的文档不是活动文档，即使将其设置为活动文档也不能这样使用命令的。。。
还有你的炸开所有块的所有嵌套块的函数也不能炸开3层及以上的嵌套，我记得我写过一个可以炸开所有嵌套的，为什么不用？

龙龙仔

;;BDYCAD
;;想重新清理CAD的資料,做法是打開這個圖, 再把全部的塊炸開, 后用PURGE清理塊, 后存盤退出的.

;;1.打開圖檔
(setq TET "E3DB.DWG")
(if (setq TET (findfile TET))
  (setq WW (vla-open (vla-get-documents (vlax-get-acad-object)) TET))
)

;;2.用VLA-EXPLODE把全部的塊炸開
;;我記得以前有提供過炸開嵌套圖塊的VLISP程序(炸開圖塊速度比較快)
;;但那是初稿,程序本身問題不少,慢慢解決吧!


;;3.用VLA-DELETE方法清理圖塊
;;這個要注意閃開 LAYOUTS & XREF

;;4.存盤退出
(vla-save WW)
(prompt (strcat "\n" TET " <處理完成>!!!"))
(vla-close WW :vlax-false)


;;並注意以下MEFLYING版主所說:

;;這是完全的ACTIVEX的操作了，操作對象都是打開的DOC中的內容，
;;用的都是object對象，你無法用AUTOLISP一般程序來控制了，
;;就是說，你原來的處理函數都必須改成用ACTIVEX來處理，
;;而且不能有交互操作。
;;你不能將打開文檔處於當前文檔，因為這個打開的文檔裡沒有加
;;載和運行任何函數（注意函數的加載並不是對這個AUTOCAD的，
;;而是對於某個文檔的），所以當它至於最前端的時候，所有程
;;序的執行都停止了，知道你運行程序的那個文檔到最前端的
;;時候程序才會繼續。你必須學會ACTIVEX技術，才能完成你的功能

;S:VLISP通常會遇到各種意想不到的問題,炸開嵌套圖塊的VLISP程序(到現在我也會遇到問題,氣死人!嵌套圖塊--有可能包含一些其怪的東西)