用lisp语言写一段快捷键为nv的2023版cad批量提取点坐标,生成dat文件并且由用户自定义导出到文件夹的代码
时间: 2023-02-06 13:14:29 浏览: 110
好的,这是一段使用 Lisp 语言编写的代码,可以在 2023 版 CAD 中使用快捷键 `nv` 批量提取点坐标,生成 dat 文件,并由用户自定义导出到文件夹:
```
(defun c:nv (/ ss i j k ent pnt)
(setq ss (ssget))
(setq i 0)
(while (setq ent (ssname ss i))
(setq pnt (entget ent))
(setq i (1+ i))
(setq j 0)
(while (setq k (assoc j pnt))
(if (equal (cdr k) "10")
(princ (cdr (assoc 10 pnt)));; x坐标
(if (equal (cdr k) "20")
(princ (cdr (assoc 20 pnt)));; y坐标
(if (equal (cdr k) "30")
(princ (cdr (assoc 30 pnt))) ;; z坐标
)
)
)
(setq j (1+ j))
)
(princ "\n")
)
(setq fname (getfiled "请选择导出文件夹" "*.dat" "dat" 0))
(setq fp (open fname "w"))
(foreach x lst
(write-line x fp)
)
(close fp)
)
(defun getfiled (prompt default_ext filter_string initial_directory)
(vl-catch-all-apply
(function (lambda ()
(if (not initial_directory)
(setq initial_directory (getvar "dwgprefix")))
(if (not default_ext)
(setq default_ext "*"))
(if (not filter_string)
(setq filter_string default_ext))
(apply
(function vl-file-getname)
(append (list prompt default_ext filter_string initial_directory)
nil))))
(function (lambda (err)
(if (and (eq (car err) 'error) (eq (cadr err) 'function-does-not-exist))
(apply (function getfname)
(list prompt default_ext filter_string initial_directory))
(apply (function error) err))))))
```
上述代码使用了 CAD 内置的函数 `ssget` 和 `entget` 来获取选中的实体和实体信息,并使用 `princ` 函数将点的