明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3009|回复: 7

求教打开dwg的遍历循环问题-高效率

[复制链接]
发表于 2011-11-24 10:25:04 | 显示全部楼层 |阅读模式
;打开文档都运行一个命令的.lsp
(defun C:qb () ;;
(vlax-for i (vla-get-Documents (vlax-get-acad-object))
     (vla-SendCommand i "bj A3 A ")
    )
)

命令:bj A3 A是一lisp程序的三个参数
现在的情况是需要依次点击完2次打开的dwg后,打开的dwg文件就自动运行了(bj A3 A)的命令参数
有没有办法实现,让他自动依次运行一下这些参数:
自己编写的打印程序命令行如下:
命令: bj
出图大小A3[3]/A4[4]:<A3>
打印全部布局[A]/当前布局[D]:<A>
谢谢大侠们的指点!

 楼主| 发表于 2011-11-24 14:53:59 | 显示全部楼层
人在楼还空缺啊
发表于 2011-11-24 15:18:52 | 显示全部楼层
用lisp可以采用加载SCR脚本文件实现:打开某个图纸——执行某个lisp函数——关闭图纸——打开某个图纸——执行某个lisp函数——关闭图纸……
论坛里边有批量打印的例子
发表于 2011-11-26 17:04:01 | 显示全部楼层
反应器可否实现?
发表于 2011-11-26 17:17:05 | 显示全部楼层
确保bj每次打开文件时都加载
发表于 2011-11-26 22:21:28 | 显示全部楼层
本帖最后由 wade320 于 2011-11-26 22:27 编辑

;;; Required AutoCAD 2000i inside Windows 98
;;; For Drawing copy (bind & save your files)
;;; 2/2/2004 revised by Eric Wong
;;; Note: This Lisp required DOSlib 5.x by Robert McNeel & Associate
;;; And required "Express tools V1-9"


(defun MY_ERR (S) ; If an error (such as CTRL-C) occurs
  (if (/= S "Function cancelled")
    (princ (strcat "\nError: " S))
  )
  (if OLDERR
    (setq *ERROR* OLDERR)
  )
  (if SCRFILE
    (close SCRFILE)
  )
  (princ)
)
;;;new function -- checkbox!!
(defun SDIR (/ PDIR2 PDLIST PDLISTN PDLISTN2 PSDIRLT PSDIR DMSG)
  (if (= PDIR NIL)
    (setq PDIR2 (getvar "dwgprefix"))
    (setq PDIR2 PDIR)
  ) ;_ end of if
  (if (setq PDIR (dos_getdir "Select a Directory to plot" PDIR2))
    (progn (dos_drive (substr PDIR 1 2)) (dos_chdir PDIR))
    (exit)
  ) ;_ end of if
  (setq DMSG (strcat "Select the files to register: <" PDIR ">"))
  (setq        PSDIRLT        (dos_subdir PDIR)
        PDLIST        (dos_dir "*.dwg")
  ) ;_ end of setq
  (foreach PSDIR PSDIRLT
    (setq PSDLIST (dos_dir (strcat PDIR PSDIR "\\*.DWG"))
          PSDLIST (mapcar '(lambda (%1) (strcat PSDIR "\\" %1)) PSDLIST)
          PDLIST  (append PDLIST PSDLIST)
    ) ;_ end of setq
  ) ;_ end of foreach
  (setq PDLIST (mapcar '(lambda (%1) (cons %1 0)) PDLIST))
  (setq PDLISTN (dos_checklist "ALL PART REG." DMSG PDLIST))
  (setq PDLISTN2 (vl-remove-if '(lambda (%1) (= (cdr %1) 0)) PDLISTN))
  (if PDLISTN2
    (setq PDLISTN2 (mapcar '(lambda (%1) (car %1)) PDLISTN2))
    (exit)
  ) ;_ end of IF
  (setq PDLISTN2 (acad_strlsort PDLISTN2))
  (setq X (cons PDIR PDLISTN2))
) ;_ end of defun
;;;

(setq dwgpath nil
      F        nil
      FL nil
      F1 nil
      X        nil
      scrfile nil)

   ;initialize
(defun init  ()
  (sdir)
  (setq dwgpath (car X))
  (setq X (acad_strlsort (cdr X)))
  (setq        n2 (rtos (length X) 2 0)
        n1 "1")
  (if (= n2 1)
    (setq dwgs "Drawing")
    (setq dwgs "Drawings")))
   ;make script file
(defun PROCESS (/ SCRFILE DMSG)
  (setq SCRFILE (open "c:/allpart.scr" "w"))
  (write-line
    (strcat
      "(dos_getprogress
      \"All Part reg             "
      N2
      " "
      DWGS
      " selected total \"
      \"The Selected files is being progress, Please wait...\" "
      N2
      ")"
     )
    SCRFILE
  )
  (write-line "(setvar \"cmddia\" 0)" SCRFILE)
  (foreach DWGFILE X
    ;(write-line "(load \"allpart.lsp\")" SCRFILE)
    ;(write-line (strcat "(AP_OPENP \" DWGPATH DWGFILE " \ ")") SCRFILE)
    (if        (= CHKSDI 1)
      (write-line (strcat "open y \"" DWGPATH DWGFILE "\"") SCRFILE)
      (write-line (strcat "open \"" DWGPATH DWGFILE "\"") SCRFILE)
    )
    (write-line "anew" SCRFILE);anew是一个lisp函数就是图纸打开后执行anew这个lisp程序
    (write-line "(dos_getprogress -1)" SCRFILE)
    (if        (= N1 N2)
      (progn (write-line "(dos_getprogress t)" SCRFILE)
             (write-line
               (strcat "(dos_msgbox \""
                       N2
                       " Drawing(s) has been process.\" \"Process\" 1 3 5)"
               )
               SCRFILE
             )
      )
    )
    (setq N1 (rtos (+ 1 (atoi N1)) 2 0))
    (write-line ".CLOSE N" SCRFILE)
  )
  (write-line "(setvar \"cmddia\" 1)" SCRFILE)
  (close SCRFILE)
  (command "script" "c:/allpart.scr")
)
(defun AP_OPENP        (DWGNAME)
  (if (= NIL (dos_openp DWGNAME))
    (vla-open DBXDOC (findfile DWGNAME))
    (progn
      (defun WAITTIME ()
        (princ
          (strcat
            "\rThis file is opened by someone, now waiting for file "
            DWGNAME
            "... "
            (menucmd
              "M=$(edtime,$(-,$(getvar,date),$(getvar,userr5)),HH:MM:SS.MSEC)"
            )
          )
        )
      )
      (setvar "USERR5" (getvar "date"))
      (while (dos_openp DWGNAME) (WAITTIME))
      (setq WAITTIME NIL)
      (princ "\n")
    )
  )
)
(defun C:ALLPART (/ X DWGPATH)
  ;;load Doslib if not loaded
  (defun LOAD_DOSLIB (/ LIBFILE FOUND ARXFILE)
    (if        (= "15" (substr (getvar "acadver") 1 2))
      (setq LIBFILE "doslib2k.arx")
      (setq LIBFILE "doslib2004.arx")
    )
    (setq FOUND (member LIBFILE (arx)))
    (if        (not FOUND)
      (setq FOUND (arxload (findfile LIBFILE) NIL))
    )
    (if        FOUND
      t
      NIL
    )
  )
  (cond        ((< (atoi (substr (getvar "acadver") 1 2)) 15)
         (alert "This Lisp can run only at AutoCAD 2000 & up\nExit Now!")
         (exit)
        )
        ((= (atoi (substr (getvar "acadver") 1 2)) 15) (LOAD_DOSLIB))
        ((> (atoi (substr (getvar "acadver") 1 2)) 15) (LOAD_DOSLIB))
  )
  (if (= (getvar "sdi") 0)
    (setq CHKSDI 0)
    (setq CHKSDI 1)
  ) ;if sdi
  (setq        OLDERR        *ERROR* ; Save error routine
        *ERROR*        MY_ERR ; Substitute ours
  )
  (INIT)
  (PROCESS)
)


(princ "type \"allpart\" to start")
(princ)
这是我以前在网上找到的程序,保持了原作者,但是在2006中运行不了,这个程序就是脚本和LISP结合的例子,请高手找出程序中的问题。这个程序使用时要加载doslib文件,以前在2004版本中可以使用,但在2006版本中不知道为什么就不可以了。怎么也找不出问题.
发表于 2011-11-26 22:39:30 | 显示全部楼层
改用手动加载 DosLib ...
(defun C:ALLPART (/ X DWGPATH)
  (if (= (getvar "sdi") 0)
    (setq CHKSDI 0)
    (setq CHKSDI 1)
  )                                        ;if sdi
  (setq        OLDERR        *ERROR*                        ; Save error routine
        *ERROR*        MY_ERR                        ; Substitute ours
  )
  (INIT)
  (PROCESS)
)
发表于 2011-11-27 09:14:38 | 显示全部楼层
其实开发cad,大家选择lisp就是图个简单方便省事,依此原则,板凳的答案正解
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-17 16:00 , Processed in 0.206788 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表