不要说我吝啬，真的是我全部身家，请求明经的兄弟帮忙写个程序

tanle2020 · 发表于 2013-4-7 11:31:14

本帖最后由 tanle2020 于 2013-4-12 18:03 编辑

看图，将带编号的矩形输出编号及宽高到EXCEL。

Gu_xl · 发表于 2013-4-7 11:31:15

(defun c:tt (/ SAVEFILE SS F N E PL MINPT MAXPT WH S DATA cmdecho)
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(if (and
(setq savefile (getfiled "" "" "csv" 1))
(setq ss (ssget '((0 . "lwpolyline")
(-4 . "<or")
(70 . 129)
(70 . 1)
(-4 . "or>")
(90 . 4)
)
)
)
)
(progn
(setq f (open savefile "a"))
(WRITE-LINE "编号,宽度,高度" f)
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq pl (mapcar 'cdr
(vl-remove-if-not
'(lambda (x) (= 10 (car x)))
(entget e)
)
)
)
(setq minpt (apply 'mapcar (cons 'min pl))
maxpt (apply 'mapcar (cons 'max pl))
)
(setq wh (list (distance (car pl) (cadr pl))
(distance (caddr pl) (cadr pl))
)
)
(command "zoom" "w" minpt maxpt "zoom" ".95x")
(setq s (ssget "wp" pl '((0 . "*text"))))
(if s
(setq data (cons (list (cdr (assoc 1 (entget (ssname s 0))))
(rtos (apply 'max wh) 2 2)
(rtos (apply 'min wh) 2 2)
)
data
)
)
)
)
(setq data (vl-sort data '(lambda (a b) (< (car a) (car b)))))
(foreach a data
(WRITE-LINE (strcat (car a) "," (cadr a) "," (caddr a)) f)
)
(close f)
)
)
(setvar 'cmdecho cmdecho)
(princ)
)

(defun c:tt (/ SAVEFILE SS F N E PL MINPT MAXPT WH S DATA cmdecho) 
  (setq cmdecho (getvar 'cmdecho)) 
  (setvar 'cmdecho 0) 
  (if (and 
        (setq savefile (getfiled "" "" "csv" 1)) 
        (setq ss (ssget '((0 . "lwpolyline") 
                          (-4 . "<or") 
                          (70 . 129) 
                          (70 . 1) 
                          (-4 . "or>") 
                          (90 . 4) 
                          ) 
                        ) 
              ) 
        ) 
    (progn 
      (setq f (open savefile "a")) 
      (WRITE-LINE "编号,宽度,高度" f) 
      (repeat (setq n (sslength ss)) 
        (setq e (ssname ss (setq n (1- n)))) 
        (setq pl (mapcar 'cdr 
                         (vl-remove-if-not 
                           '(lambda (x) (= 10 (car x))) 
                           (entget e) 
                           ) 
                         ) 
              ) 
        (setq minpt (apply 'mapcar (cons 'min pl)) 
              maxpt (apply 'mapcar (cons 'max pl)) 
              ) 
        (setq wh (list (distance (car pl) (cadr pl)) 
                       (distance (caddr pl) (cadr pl)) 
                       ) 
              ) 
        (command "zoom" "w" minpt maxpt "zoom" ".95x") 
        (setq s (ssget "wp" pl '((0 . "*text")))) 
        (if s 
          (setq data (cons (list (cdr (assoc 1 (entget (ssname s 0)))) 
                                 (rtos (apply 'max wh) 2 2) 
                                 (rtos (apply 'min wh) 2 2) 
                                 ) 
                           data 
                           ) 
                ) 
          ) 
        ) 
      (setq data (vl-sort data '(lambda (a b) (< (car a) (car b))))) 
      (foreach a data 
        (WRITE-LINE (strcat (car a) "," (cadr a) "," (caddr a)) f) 
        ) 
      (close f) 
 
      ) 
    ) 
  (setvar 'cmdecho cmdecho) 
  (princ) 
  )

haoryh · 发表于 2013-4-7 14:25:56

论坛上已有相关代码，自己多找找！

tanle2020 · 发表于 2013-4-8 09:51:21

haoryh 发表于 2013-4-7 14:25
论坛上已有相关代码，自己多找找！

搜过了，求链接

haoryh · 发表于 2013-4-8 13:34:21

tanle2020 发表于 2013-4-8 09:51
搜过了，求链接

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99556

tanle2020 · 发表于 2013-4-9 09:23:15

haoryh 发表于 2013-4-8 13:34
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99556

那个我看了，没有按编号统计输出。

潇湘飞雨 · 发表于 2013-4-11 17:55:56

版主就是牛X

461045462 · 发表于 2013-4-12 09:04:32

谢谢版主的分享！
收藏学习
谢谢

tanle2020 · 发表于 2013-4-12 18:02:11

Gu_xl 发表于 2013-4-11 14:33

非常完美的解决，程序好！人更好！

cxjzxh · 发表于 2013-4-13 17:03:12

版主这个程序的用途是什么啊

账号		自动登录	找回密码
密码			注册

不要说我吝啬，真的是我全部身家，请求明经的兄弟帮忙写个程序

最佳答案

相关帖子

点评