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

tanle2020

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

Gu_xl

1. (defun c:tt (/ SAVEFILE SS F N E PL MINPT MAXPT WH S DATA cmdecho)
   
2.   (setq cmdecho (getvar 'cmdecho))
   
3.   (setvar 'cmdecho 0)
   
4.   (if (and
   
5.         (setq savefile (getfiled "" "" "csv" 1))
   
6.         (setq ss (ssget '((0 . "lwpolyline")
   
7.                           (-4 . "<or")
   
8.                           (70 . 129)
   
9.                           (70 . 1)
   
10.                           (-4 . "or>")
    
11.                           (90 . 4)
    
12.                           )
    
13.                         )
    
14.               )
    
15.         )
    
16.     (progn
    
17.       (setq f (open savefile "a"))
    
18.       (WRITE-LINE "编号,宽度,高度" f)
    
19.       (repeat (setq n (sslength ss))
    
20.         (setq e (ssname ss (setq n (1- n))))
    
21.         (setq pl (mapcar 'cdr
    
22.                          (vl-remove-if-not
    
23.                            '(lambda (x) (= 10 (car x)))
    
24.                            (entget e)
    
25.                            )
    
26.                          )
    
27.               )
    
28.         (setq minpt (apply 'mapcar (cons 'min pl))
    
29.               maxpt (apply 'mapcar (cons 'max pl))
    
30.               )
    
31.         (setq wh (list (distance (car pl) (cadr pl))
    
32.                        (distance (caddr pl) (cadr pl))
    
33.                        )
    
34.               )
    
35.         (command "zoom" "w" minpt maxpt "zoom" ".95x")
    
36.         (setq s (ssget "wp" pl '((0 . "*text"))))
    
37.         (if s
    
38.           (setq data (cons (list (cdr (assoc 1 (entget (ssname s 0))))
    
39.                                  (rtos (apply 'max wh) 2 2)
    
40.                                  (rtos (apply 'min wh) 2 2)
    
41.                                  )
    
42.                            data
    
43.                            )
    
44.                 )
    
45.           )
    
46.         )
    
47.       (setq data (vl-sort data '(lambda (a b) (< (car a) (car b)))))
    
48.       (foreach a data
    
49.         (WRITE-LINE (strcat (car a) "," (cadr a) "," (caddr a)) f)
    
50.         )
    
51.       (close f)
    
52. 
    
53.       )
    
54.     )
    
55.   (setvar 'cmdecho cmdecho)
    
56.   (princ)
    
57.   )

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

haoryh

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

tanle2020

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

搜过了，求链接

haoryh

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

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

tanle2020

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

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

潇湘飞雨

版主就是牛X

461045462

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

tanle2020

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

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

cxjzxh

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