求DXF输出路径 LISP

wuwubaibai 发表于 2021-2-28 16:07:35

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

lengxiaxi 发表于 2024-3-13 14:23:28

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

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

vitalgg 发表于 2021-3-6 19:16:02

把函数整合了。你试下。

(defun string:from-lst (lst Separator)
"列表转成字符串"
(if (cdr lst)
(strcat (car lst) Separator (string:from-lst (cdr lst) Separator))
(car lst)
)
)

(defun string:to-lst (str Separator / pos)
"字符串转成列表"
(if (setq pos (vl-string-search Separator str))
(cons (substr str 1 pos)
      (string:to-lst (substr str (+ pos 1 (strlen Separator))) Separator)
      )
(list str)
)
)

(defun at-pm:saveas-dxf (file-name file-path ss)
"save selected entity to dxf"
(if (and (= 'str (type file-name))
   (/= "" file-name)
   (vl-file-directory-p file-path)
   (> (sslength ss) 0))
   (progn
;;(push-var)
(setq file-name
      (string:from-lst
      (reverse (cdr (reverse (string:to-lst file-name "."))))
      "."))
(setvar "cmdecho" 0)
(setvar "filedia" 0)
(vl-cmdf "_.dxfout" (strcat file-path "\\" file-name)"O" ss "" "16" )
;;(pop-var)
T)
   nil
   )
(setvar "filedia" 1)
)

(defun c:mj-req ()
(at-pm:saveas-dxf
(getvar "DWGNAME")
"C:\\2dTO3d"
(ssget '((-4 . "<NOT") (8 . "DIM,TEMP")(-4 . "NOT>")))))

htlaser 发表于 2021-3-1 08:35:30

本帖最后由 htlaser 于 2021-3-3 08:35 编辑

(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 pathdate))
(setvar "FILEDIA" 0)
(vl-cmdf "_.dxfout" str "O" (ssget '((8 . "TEMP"))) "" "")
(setvar "FILEDIA" getv3)
(princ)
)

wuwubaibai 发表于 2021-3-3 00:37:03

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 发表于 2021-3-3 07:51:48

本帖最后由 vitalgg 于 2021-3-4 21:18 编辑

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

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

(defun c:mj-req ()
(at-pm:saveas-dxf
(getvar "DWGNAME")
"C:\\2dTO3d"
(ssget '((-4 . "<NOT") (8 . "DIM,TEMP")(-4 . "NOT>")))))

htlaser 发表于 2021-3-3 08:31:51

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

已修改再试试

wuwubaibai 发表于 2021-3-3 22:50:50

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

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

wuwubaibai 发表于 2021-3-3 22:51:43

本帖最后由 wuwubaibai 于 2021-3-3 22:57 编辑

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

htlaser 发表于 2021-3-4 09:42:35

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

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

vitalgg 发表于 2021-3-4 10:04:10

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

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

wuwubaibai 发表于 2021-3-4 20:44:25

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

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

页: [1] 2 3

明经CAD社区's Archiver

求DXF输出路径 LISP