用lisp编程，打开D:\1.dwg图形，利用编程命令在此图形路径下新建文件夹命令为A

Question

用lisp编程，打开D:\1.dwg图形，利用编程命令在此图形路径下新建文件夹命令为A再将1.dwg存入到此新建文件夹下即D:\A\1.dwg

Answer 1

写了一个autolisp，注意以下条件：

打开的dwg文件必须要保存。

如果新文件夹没有建立成功，查看cad是否安装了【Express Tools】。


(defun c:tes ( / &tr1 ff1 ff2)
 (setq ff1 "D:\\A");建立文件夹
 (if (VXMAKEDIRECTORY ff1);如果建立成功
  (progn
   (setq &tr1 (getvar "dwgname"));提取文件名
   (if (setq ff2 (findfile &tr1));如果找到这个文件
    (vl-file-copy ff2 (strcat ff1 "\\" &tr1));复制文件到新文件夹里面
   )
  )
 )
 (princ)
);appload命令加载autolisp，命令【TES】，看附件下载。

追问

建立文件夹为变量，名称在命令栏提示输入

追答

这个要你自己修改，附件里面的程序只是提供样式。

追问

真不知道如何改

追答

重新写了一个，需要自己选择新文件夹，相当于cad的另存功能：

(defun c:tes ( / &tr1 ff2 path)
 (vl-load-com)
 (if (null path1) (setq path1 (getvar "dwgprefix")) )
 (if (setq path (strcat (vl-string-right-trim "\\" (strcase (acet-ui-pickdir "选择目录"
  (vl-string-right-trim "\\" path1) "保存dwg文件" ))) "\\"))
  (progn
   (setq &tr1 (getvar "dwgname"));提取文件名
   (if (setq ff2 (findfile &tr1));如果找到这个文件
    (vl-file-copy ff2 (strcat path &tr1));复制文件到新文件夹里面
   )
  )
 )
 (princ)
)追问

(setq &tr1 (getvar "dwgprefix"))
(setq str (getstring "\n 输入文件夹名: " ))
(setq ff1 (strcat &tr1 "\\" str))

追答(defun c:tes ( / &tr1 ff1 ff2)
 (vl-load-com)
 (if (= (setq ff1 (getstring t (strcat "\n请输入新文件夹路径，回车结束输入:<" "D:\\A" ">"))) "") (setq ff1 "D:\\A"))
 (if (and (/= ff1 "") (VXMAKEDIRECTORY ff1));如果建立成功
  (progn
   (setq &tr1 (getvar "dwgname"));提取文件名
   (if (setq ff2 (findfile &tr1));如果找到这个文件
    (vl-file-copy ff2 (strcat ff1 "\\" &tr1));复制文件到新文件夹里面
   )
  )
 )
 (princ)
)

字数限制，VXMAKEDIRECTORY子程序要下载附件里面的内容。

追问

vxmakedirectory函数报错

追答(defun VXMAKEDIRECTORY (DIR / CURDIR DRVOBJ FILSYS RETVAL TMPLST TMPVAL)
  (setq FILSYS (vlax-create-object "Scripting.FileSystemObject")
 CURDIR (vl-string-right-trim "\\" (vl-string-right-trim "/" DIR))
  )
  (while (/= (setq TMPVAL (vl-filename-directory CURDIR)) CURDIR)
    (setq TMPLST (cons TMPVAL TMPLST)
   CURDIR TMPVAL
    )
  )
  (setq
    RETVAL (cond
      ((= (vlax-invoke FILSYS 'DRIVEEXISTS TMPVAL) 0) NIL)
      ((setq DRVOBJ (vlax-invoke FILSYS 'GETDRIVE TMPVAL))
       (cond
  ((= (vlax-get DRVOBJ 'ISREADY) 0) NIL)
  (t
   (foreach MEMB TMPLST
     (cond
       ((= (vlax-invoke FILSYS 'FOLDEREXISTS MEMB) -1))
       ((vlax-invoke FILSYS 'CREATEFOLDER MEMB))
     )
   )
   (cond
     ((= (vlax-invoke FILSYS 'FOLDEREXISTS DIR) -1))
     ((vlax-invoke FILSYS 'CREATEFOLDER DIR) t)
     (t NIL)
   )
  )
       )
      )
    )
  )
  (if DRVOBJ
    (vlax-release-object DRVOBJ)
  )
  (vlax-release-object FILSYS)
  RETVAL
)追问

这段代码有问题，写入块时，"0,0"报错

command "_.wblock" (strcat ff1 这里双斜杠线，该怎么改

能解决么？

已解决

谢谢了