求DXF输出路径 LISP

wuwubaibai

请问各位大大们~小弟想框选物件~略过DIM,TEMP图层后DXFOUT转存于C:\2dTO3d\ 目录之下~请大大帮忙感谢

lengxiaxi

vitalgg 发表于 2021-3-6 19:16
把函数整合了。你试下。

(getvar "DWGNAME")   这里，如何改成手动命名；有时候自定义名称可能灵活些

vitalgg

把函数整合了。你试下。

1. (defun string:from-lst        (lst Separator)
   
2.   "列表转成字符串"
   
3.   (if        (cdr lst)
   
4.         (strcat (car lst) Separator (string:from-lst (cdr lst) Separator))
   
5.         (car lst)
   
6.         )
   
7.   )
   
8. 
   
9. (defun string:to-lst        (str Separator / pos)
   
10.   "字符串转成列表"
    
11.   (if        (setq pos (vl-string-search Separator str))
    
12.         (cons (substr str 1 pos)
    
13.               (string:to-lst (substr str (+ pos 1 (strlen Separator))) Separator)
    
14.               )
    
15.         (list str)
    
16.         )
    
17.   )
    
18. 
    
19. (defun at-pm:saveas-dxf (file-name file-path ss)
    
20.   "save selected entity to dxf"
    
21.   (if (and (= 'str (type file-name))
    
22.            (/= "" file-name)
    
23.            (vl-file-directory-p file-path)
    
24.            (> (sslength ss) 0))
    
25.       (progn
    
26.         ;;(push-var)
    
27.         (setq file-name
    
28.               (string:from-lst
    
29.                (reverse (cdr (reverse (string:to-lst file-name "."))))
    
30.                "."))
    
31.         (setvar "cmdecho" 0)
    
32.         (setvar "filedia" 0)
    
33.         (vl-cmdf "_.dxfout" (strcat file-path "\\" file-name)  "O" ss "" "16" )
    
34.         ;;(pop-var)
    
35.         T)
    
36.       nil
    
37.       )
    
38.   (setvar "filedia" 1)
    
39.   )
    
40. 
    
41. (defun c:mj-req ()
    
42.   (at-pm:saveas-dxf
    
43.    (getvar "DWGNAME")
    
44.    "C:\\2dTO3d"
    
45.    (ssget '((-4 . "<NOT") (8 . "DIM,TEMP")(-4 . "NOT>")))))
    
46. 
    

(defun string:from-lst        (lst Separator)<br />   "列表转成字符串"<br />   (if        (cdr lst)<br />         (strcat (car lst) Separator (string:from-lst (cdr lst) Separator))<br />         (car lst)<br />         )<br />   )<br /> <br /> (defun string:to-lst        (str Separator / pos)<br />   "字符串转成列表"<br />   (if        (setq pos (vl-string-search Separator str))<br />         (cons (substr str 1 pos)<br />               (string:to-lst (substr str (+ pos 1 (strlen Separator))) Separator)<br />               )<br />         (list str)<br />         )<br />   )<br /> <br /> (defun at-pm:saveas-dxf (file-name file-path ss)<br />   "save selected entity to dxf"<br />   (if (and (= 'str (type file-name))<br />            (/= "" file-name)<br />            (vl-file-directory-p file-path)<br />            (> (sslength ss) 0))<br />       (progn<br />         ;;(push-var)<br />         (setq file-name<br />               (string:from-lst<br />                (reverse (cdr (reverse (string:to-lst file-name "."))))<br />                "."))<br />         (setvar "cmdecho" 0)<br />         (setvar "filedia" 0)<br />         (vl-cmdf "_.dxfout" (strcat file-path "\\" file-name)  "O" ss "" "16" )<br />         ;;(pop-var)<br />         T)<br />       nil<br />       )<br />   (setvar "filedia" 1)<br />   )<br /> <br /> (defun c:mj-req ()<br />   (at-pm:saveas-dxf<br />    (getvar "DWGNAME")<br />    "C:\\2dTO3d"<br />    (ssget '((-4 . "<NOT") (8 . "DIM,TEMP")(-4 . "NOT>")))))<br /> <br />

htlaser

(defun c:dxf (/ date getv getv2 getv3 path str)
(setvar "cmdecho" 0)
(princ "\n功能 [自动存DXF档]") (vl-mkdir "C:\\2dTO3d\\ " ) ;创建目录
(setq getv3 (getvar "FILEDIA"))
(setq date (getvar "DWGNAME")) (setq date  (substr date 1 (- (strlen date ) 4)));去后缀
(setq path "C:\\2dTO3d\\ ")   
(setq str (strcat path  date))  
(setvar "FILEDIA" 0)
(vl-cmdf "_.dxfout" str "O" (ssget '((8 . "TEMP"))) "" "")
(setvar "FILEDIA" getv3)  
(princ)
)

wuwubaibai

htlaser 发表于 2021-3-1 08:35
(defun c:dxf (/ date getv getv2 getv3 path str)
(setvar "cmdecho" 0)
(princ "\n功能 [自动存DXF档]" ...

大大测试后显示错误~不知哪边出错~
C:\2dTO3d\ CM1472240_A02-099.dwg.dxf": 无法开启档案
没有建立任何的dxf~同时filedia也回不到1

vitalgg

CAD命令 mj-req
其它未定义的函数 请安装 http://atlisp.cn @lisp 基础函数库

1. (defun at-pm:saveas-dxf (file-name file-path ss)
   
2.   "保存选中的图素到dxf"
   
3.   (if (and (= 'str (type file-name))
   
4.            (/= "" file-name)
   
5.            (vl-file-directory-p file-path)
   
6.            (> (sslength ss) 0))
   
7.       (progn
   
8.         (push-var)
   
9.         (setq file-name
   
10.               (string:from-lst
    
11.                (reverse (cdr (reverse (string:to-lst file-name "."))))
    
12.                "."))
    
13.         (setvar "cmdecho" 0)
    
14.         (setvar "filedia" 0)
    
15.         (vl-cmdf "_.dxfout" (strcat file-path "\\" file-name)  "O" ss "" "16" )
    
16.         (pop-var)
    
17.         T)
    
18.       nil
    
19.       )
    
20.   )
    
21. (@:add-menu "输出打印" "局部导DXF" "(at-pm:menu-saveas-dxf)")
    
22. (defun at-pm:menu-saveas-dxf (/ folder ss)
    
23.   (@:help "保存选中的图素到同名的 dxf 文件")
    
24.   (prompt  "请选要导出dxf文件的图素:")
    
25.   (setq ss (ssget))
    
26.   (setq folder (system:get-folder "请选要dxf文件输出的目录:"))
    
27.   (at-pm:saveas-dxf
    
28.    (getvar "DWGNAME")
    
29.    folder ss))
    
30. 
    
31. (defun c:mj-req ()
    
32.   (at-pm:saveas-dxf
    
33.    (getvar "DWGNAME")
    
34.    "C:\\2dTO3d"
    
35.    (ssget '((-4 . "<NOT") (8 . "DIM,TEMP")(-4 . "NOT>")))))
    

(defun at-pm:saveas-dxf (file-name file-path ss)<br />   "保存选中的图素到dxf"<br />   (if (and (= 'str (type file-name))<br />            (/= "" file-name)<br />            (vl-file-directory-p file-path)<br />            (> (sslength ss) 0))<br />       (progn<br />         (push-var)<br />         (setq file-name<br />               (string:from-lst<br />                (reverse (cdr (reverse (string:to-lst file-name "."))))<br />                "."))<br />         (setvar "cmdecho" 0)<br />         (setvar "filedia" 0)<br />         (vl-cmdf "_.dxfout" (strcat file-path "\\" file-name)  "O" ss "" "16" )<br />         (pop-var)<br />         T)<br />       nil<br />       )<br />   )<br /> (@:add-menu "输出打印" "局部导DXF" "(at-pm:menu-saveas-dxf)")<br /> (defun at-pm:menu-saveas-dxf (/ folder ss)<br />   (@:help "保存选中的图素到同名的 dxf 文件")<br />   (prompt  "请选要导出dxf文件的图素:")<br />   (setq ss (ssget))<br />   (setq folder (system:get-folder "请选要dxf文件输出的目录:"))<br />   (at-pm:saveas-dxf<br />    (getvar "DWGNAME")<br />    folder ss))<br /> <br /> (defun c:mj-req ()<br />   (at-pm:saveas-dxf<br />    (getvar "DWGNAME")<br />    "C:\\2dTO3d"<br />    (ssget '((-4 . "<NOT") (8 . "DIM,TEMP")(-4 . "NOT>")))))<br />

htlaser

wuwubaibai 发表于 2021-3-3 00:37
大大测试后显示错误~不知哪边出错~
C:\2dTO3d\ CM1472240_A02-099.dwg.dxf": 无法开启档案
没有建立任 ...

已修改  再试试

wuwubaibai

vitalgg 发表于 2021-3-3 07:51
CAD命令 mj-req
其它未定义的函数 请安装 http://atlisp.cn @lisp 基础函数库

大大~出现了~
感谢大大的帮忙
错误: no function definition: PUSH-VAR

wuwubaibai

htlaser 发表于 2021-3-3 08:31
已修改  再试试

修改后确认ok谢谢大大帮忙~感谢
抱歉~再麻煩大大轉出後的檔名可以批量下去~如 檔名-p1檔名-p2~不知會不會非常麻煩~因為一個檔案太多圖檔~變成要人工編號~感謝

htlaser

wuwubaibai 发表于 2021-3-3 22:51
修改后确认ok谢谢大大帮忙~感谢
抱歉~再麻煩大大轉出後的檔名可以批量下去~如 檔名-p1檔名-p2~不知會不 ...

这个我就真不会了   我也是乱拼的代码

vitalgg

wuwubaibai 发表于 2021-3-3 22:50
大大~出现了~
感谢大大的帮忙
错误: no function definition: PUSH-VAR

http://atlisp.cn   @lisp 基础函数库

wuwubaibai

htlaser 发表于 2021-3-4 09:42
这个我就真不会了   我也是乱拼的代码

好的~大大能帮我第一个已经很好了~谢谢