坐标编号导出..原来用得好好的现在不能用了求修改...源码

flytoday

求大师给解决下..谢谢~

flytoday

附件传上来了....
;;; 标注好的坐标输出到: 与DWG文件同目录、同名的TXT文件中20121121；
;;; 输出样式：
;;;    X值         Y值
;;; 1, 87753.815, 52860.248
;;; 2, 2887765.655, 452850.981
;;; .
;;; .
;;; .
;;;
;;; 将编号1、2、... 写到图中.
;;;
(defun c:ZBZDC ( / ss n info ent txt pt t_h t_a tmp tmp1 tmp2 pt10 pt11 f_n f_op)
  (setq ss (ssget '((0 . "TEXT") (1 . "X=*,x=*"))))
  (setq n 0)
  (setq info '())
  (repeat (if ss (sslength ss) 0)
    (setq ent (entget (ssname ss n))
          txt (cdr (assoc 1 ent))
          pt  (cdr (assoc 10 ent))
          t_h (cdr (assoc 40 ent))
          t_a (cdr (assoc 50 ent))
          )
    (setq info (append info (list (list pt txt t_h t_a))))
    (setq n (1+ n))
    )
  (command "_.undo" "_be")
  (setq c_t '())
  (setq info (mapcar '(lambda(x)
    (progn (setq tmp (car x))
      (setq tmp1 (mapcar '(lambda(y) (- y (caddr x))) tmp)
            tmp2 (mapcar '(lambda(y) (+ y (caddr x))) tmp))
      (setq ss_tmp (ssget "c" tmp1 tmp2 '((0 . "LINE"))))
      (setq tmp (entget (ssname ss_tmp 0)))
      (setq pt10 (cdr (assoc 10 tmp)))
      (setq pt11 (cdr (assoc 11 tmp)))
      (if (or (equal (angle pt10 pt11) (cadddr x) 1e-3)
              (equal (angle pt11 pt10) (cadddr x) 1e-3))
        (cond
          ((= (sslength (ssget "c" pt10 pt10 '((0 . "LINE")))) 1)
           (setq c_t (append c_t
             (list (list (polar pt10 (angle pt11 pt10)
                                (* (caddr x) 1.1))
                         (caddr x) (cadddr x))))))
          ((= (sslength (ssget "c" pt11 pt11 '((0 . "LINE")))) 1)
           (setq c_t (append c_t
             (list (list (polar pt11 (angle pt10 pt11)
                                (* (caddr x) 1.1))
                         (caddr x) (cadddr x))))))
          )
        (cond
          ((progn (setq tmp (entget (ssname ss_tmp 1))
                        pt10 (cdr (assoc 10 tmp))
                        pt11 (cdr (assoc 11 tmp)))
             nil))
          ((= (sslength (ssget "c" pt10 pt10 '((0 . "LINE")))) 1)
           (setq c_t (append c_t
             (list (list (polar pt10 (angle pt11 pt10)
                                (* (caddr x) 1.1))
                         (caddr x) (cadddr x))))))
          ((= (sslength (ssget "c" pt11 pt11 '((0 . "LINE")))) 1)
           (setq c_t (append c_t
             (list (list (polar pt11 (angle pt10 pt11)
                                (* (caddr x) 1.1))
                         (caddr x) (cadddr x))))))
          ))
      (and
        (setq ss_tmp (ssget "c" tmp1 tmp2 '((0 . "TEXT") (1 . "Y=*,y=*"))))
        (setq tmp (cdr (assoc 1 (entget (ssname ss_tmp 0)))))
        (setq x (list (car x) (cadr x) tmp))
        )
      x)) info))
  (setq info (mapcar 'append info c_t))
  (setq info (vl-sort info '(lambda (x y) (< (caar  x) (caar  y)))))        ;X坐标从小到大排序.
  (setq info (vl-sort info '(lambda (x y) (< (cadar x) (cadar y)))))        ;Y坐标从小到大排序.
  (setq c_t  (mapcar 'cdddr info))
  (setq f_n  (getvar "DWGname")
        f_n  (strcat (substr f_n 1 (- (strlen f_n) 4)) ".txt")
        f_n  (strcat (getvar "DWGPREFIX") f_n)
        )
  (setq n 0)
  (setq f_op (open f_n "w"))
  (princ "     X 值       Y 值\n" f_op)
  (mapcar '(lambda(x y)
             (princ (strcat (itoa (setq n (1+ n))) ", ") f_op)
             (princ (substr (cadr  x) 3) f_op)
             (princ ", " f_op)
             (princ (substr (caddr x) 3) f_op)
             (princ "\n" f_op)
             (command "._CIRCLE" "_non" (car y) (* (cadr y) 1.1))
             (command "._TEXT" "_j" "_mc" "_non" (car y) (cadr y) (* (/ (caddr y) pi) 180) (itoa n))
             ) info c_t)
  (close f_op)
  (command "_.undo" "_end")
  (princ)
  )

;|
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget '((0 . "TEXT") (1 . "X=*,Y=*")))) (progn
  (setq i 0 dll (list))
  (repeat (sslength ss)
   (setq ent (entget(ssname ss i))
         i (1+ i)
         dll (cons (cons (cdr(assoc 10 ent)) (cdr(assoc 1 ent))) dll))
  )
  (setq dll (reverse dll))
  (setq sdll (vl-sort dll '(lambda (x y) (< (caar x) (caar y)))))
  (setq sdll (vl-sort sdll '(lambda (x y) (< (cadar x) (cadar y)))))
  (setq fn (if fn fn ""))
  (if (setq fn (getfiled "输出文件名" fn "txt" 1)) (progn
   (setq fp (open fn "w"))
   (setq ppt T)
   (princ "X  值         Y  值" fp)
   (foreach x sdll
    (if ppt
     (princ (strcat "\n" (substr (cdr x) 3)) fp)
     (princ (strcat "  " (substr (cdr x) 3)) fp)
    )
    (setq ppt (not ppt))
   )
   (close fp)
   (startapp "notepad" fn)
  ))
))
(princ)
)
|;

2013127ll

看看是不是你想要的，希望对你有帮助，这个我也是下载的。