如何利用lisp程序一次性提取CAD中点的坐标(不要点击每个点,太多了麻烦)

(DEFUN C:TT ( / ss ff ss1 en pt x y)

 (setvar "cmdecho" 0)

 (setvar "blipmode" 0)

 (setvar "dimzin" 0)

 (vl-load-com)加载vlax扩展函数

 (setq ss (ssget '((0 . "point"))) n 0)请选择点

 (if (/= ss nil)

  (progn

   (setq ff (open "d://文字到TXT.txt" "w") ss1 '())在D盘建立记事本《文字到TXT》这里可以查看内容

   (repeat (sslength ss)循环选择

    (setq en (ssname ss n) n (+ n 1)提取图元

          pt (cdr (assoc 10 (entget en)))取得点坐标

          ss1 (cons pt ss1)加入表

    )

   )

   (setq ss1 (vl-sort ss1 (function (lambda (x y)(< (car x) (car y))))))X排序从左到右

   (setq ss1 (vl-sort ss1 (function (lambda (x y)(> (cadr x) (cadr y))))))Y排序从上到下

   (foreach en ss1函数遍历表，将其中每一个元素依次赋给变量，并对每一个表达式求值

    (setq x (rtos (car en) 2 5))

    (setq y (rtos (cadr en)2 5))取得Y坐标精确到小数点后5位

    (princ x ff)

    (princ "," ff)

    (princ y ff)

    (princ "\n" ff)

   )

   (close ff)

  )

 )

 (princ)

)

这个TT命令修改了一下，可以对点坐标排序，保存到D盘《文字到TXT》记事本里面；实际上坐标需要X=；Y=这个标记的，这个标记表示大地坐标；大地坐标X=cad里面的y坐标，同样的Y=cad里面的x坐标，所以不能够随便修改文字格式。

复制下面的脚本到命令行回车即可加载，输入pldd，程序会提示选择pline，选择pline后会打印所有的三维坐标

(defun c:pldd (/ wb cc ss1 aa pts bhbz ent)

(setq ent (car (entsel "\n请选择PLINE")))

(setq wb (entget ent) cc nil bhbz (cdr (assoc 70 wb)) )

(cond

((= (cdr (assoc 0 wb)) "POLYLINE")

(setq ss1 (entnext ent))

(while (/= ss1 nil)

(setq aa (entget ss1))

(if (= (cdr (assoc 0 aa)) "VERTEX") (progn

(setq aa (cdr (assoc 10 aa)))

(if (/= aa nil) (progn

(if (= (length aa) 2)

(setq aa (list (car aa) (cadr aa) 0.0) )

)

(if (= cc nil)

(setq pts aa)

)

(setq cc (cons aa cc))

))

(setq ss1 (entnext ss1))

)

(setq ss1 nil)

)

)

(if (= bhbz 1)

(setq cc (cons pts cc))

)

)

((= (cdr (assoc 0 wb)) "LWPOLYLINE")

(setq wb (member (assoc 10 wb) wb))

(while (assoc 10 wb)

(setq aa (cdr (assoc 10 wb)))

(if (= (length aa) 2)

(setq aa (list (car aa) (cadr aa) 0.0) )

)

(if (= cc nil)

(setq pts aa)

)

(if (= (length aa) 2)

(setq aa (list (car aa) (cadr aa) 0.0) )

)

(setq cc (cons aa cc) wb (cdr wb))

(if (assoc 10 wb)

(setq wb (member (assoc 10 wb) wb))

)

)

(if (= bhbz 1)

(setq cc (cons pts cc))

)

)

((= (cdr (assoc 0 wb)) "SPLINE")

(setq wb (member (assoc 11 wb) wb))

(while (assoc 11 wb)

(setq aa (cdr (assoc 11 wb)))

(if (= (length aa) 2)

(setq aa (list (car aa) (cadr aa) 0.0) )

)

(if (= cc nil)

(setq pts aa)

)

(setq cc (cons aa cc) wb (cdr wb))

(if (assoc 11 wb)

(setq wb (member (assoc 11 wb) wb))

)

)

---