如果统计大量矩形的长度和宽度

fan_zh

fan_zh

湜１只鱼

很方便的  

haoryh

已试用，确实不知如何输出到EXCEL

cdinten

复制粘贴到EXCEL中就可以了啊

haoryh

cdinten 发表于 2012-12-3 19:35
复制粘贴到EXCEL中就可以了啊

嘿嘿、、、那样的话也许就失去编程的意义了！

fan_zh

fan_zh

yjr111

2. ;;;数学求解
   
3. (defun delta(b c / x1 x2 x3 x4 dta)
   
4.   (cond
   
5.     ((>(setq dta(-(expt b 2)(* 4  c)))0);;;长方形
   
6.       (setq x1 (/(+ b(sqrt dta))2)
   
7.             x2 (/(- b(sqrt dta))2)
   
8.             )
   
9.      (if (>= x1 x2)(setq x3 x1 x4 x2)(setq x3 x2 x4 x1))
   
10.      )
    
11.     ((equal(setq dta(-(expt b 2)(* 4  c)))0 1e-3);;;正方形
    
12.       (setq x1 (/ b 2)
    
13.             x3 x1
    
14.             x4 x1
    
15.             )     
    
16.      )
    
17.     ((<(setq dta(-(expt b 2)(* 4 c)))0);;;数学嘛
    
18.       (alert"\n无解")
    
19.      )
    
20.    )
    
21.   (if (and x3 x4)(setq jie(list x3 x4)))
    
22. )
    
23. ;;;;输出excel
    
24. (defun lst2csv(lsthead tipstr lst / ff1 ff2 i pro ele )
    
25. (SETQ lst (cons lsthead lst)
    
26.       ff1 (getfiled "输出到excel" tipstr "CSV" 1)
    
27.       ff2(open ff1 "a")
    
28.       i 0
    
29.       )
    
30. (repeat (length LST)
    
31.   (SETQ pro (nth i lst)
    
32.         ele (vl-string-translate "( )" ",,,"(vl-princ-to-string pro))
    
33.         ele (vl-string-subst "" "," ele)
    
34.         i (1+ i)
    
35.         )
    
36. (write-line ele ff2)
    
37. )
    
38. (close ff2)
    
39. )
    
40. ;;;矩形周长面积，输出excel请自理
    
41. (defun c:getzcmj(/ ss n e vlae mj zc jie jielst)
    
42. (setq ss(ssget '((0 . "LWPOLYLINE"))))
    
43.   (if ss
    
44.     (progn
    
45.       (repeat (setq n(sslength ss))
    
46.         (setq e(ssname ss (setq n(1- n)))
    
47.               vlae(vlax-ename->vla-object e)
    
48.               )
    
49.         (if (=(vla-get-closed vlae):vlax-true)
    
50.           (progn
    
51.           (setq mj(vla-get-area vlae)
    
52.                 zc(vla-get-length vlae)
    
53.                 )
    
54.           (delta (/ zc 2) mj)
    
55.           (if jie (setq jielst(cons jie jielst)))
    
56.           )
    
57.           )
    
58.       )
    
59.       )
    
60.     )
    
61. (princ (strcat "矩形长宽列表如下:" (vl-princ-to-string jielst)))
    
62. (setq lsthead  '("矩形长度" "宽度")
    
63.        tipstr "矩形长宽列表"      
    
64.        )
    
65. (lst2csv lsthead tipstr jielst)
    
66. (princ)
    
67. )

;;;数学求解<br /> (defun delta(b c / x1 x2 x3 x4 dta)<br />   (cond<br />     ((>(setq dta(-(expt b 2)(* 4  c)))0);;;长方形<br />       (setq x1 (/(+ b(sqrt dta))2)<br />             x2 (/(- b(sqrt dta))2)<br />             )<br />      (if (>= x1 x2)(setq x3 x1 x4 x2)(setq x3 x2 x4 x1))<br />      )<br />     ((equal(setq dta(-(expt b 2)(* 4  c)))0 1e-3);;;正方形<br />       (setq x1 (/ b 2)<br />             x3 x1<br />             x4 x1<br />             )     <br />      )<br />     ((<(setq dta(-(expt b 2)(* 4 c)))0);;;数学嘛<br />       (alert"\n无解")<br />      )<br />    )<br />   (if (and x3 x4)(setq jie(list x3 x4)))<br /> )<br /> ;;;;输出excel<br /> (defun lst2csv(lsthead tipstr lst / ff1 ff2 i pro ele )<br /> (SETQ lst (cons lsthead lst)<br />       ff1 (getfiled "输出到excel" tipstr "CSV" 1)<br />       ff2(open ff1 "a")<br />       i 0<br />       )<br /> (repeat (length LST)<br />   (SETQ pro (nth i lst)<br />         ele (vl-string-translate "( )" ",,,"(vl-princ-to-string pro))<br />         ele (vl-string-subst "" "," ele)<br />         i (1+ i)<br />         )<br /> (write-line ele ff2)<br /> )<br /> (close ff2)<br /> )<br /> ;;;矩形周长面积，输出excel请自理<br /> (defun c:getzcmj(/ ss n e vlae mj zc jie jielst)<br /> (setq ss(ssget '((0 . "LWPOLYLINE"))))<br />   (if ss<br />     (progn<br />       (repeat (setq n(sslength ss))<br />         (setq e(ssname ss (setq n(1- n)))<br />               vlae(vlax-ename->vla-object e)<br />               )<br />         (if (=(vla-get-closed vlae):vlax-true)<br />           (progn<br />           (setq mj(vla-get-area vlae)<br />                 zc(vla-get-length vlae)<br />                 )<br />           (delta (/ zc 2) mj)<br />           (if jie (setq jielst(cons jie jielst)))<br />           )<br />           )<br />       )<br />       )<br />     )<br /> (princ (strcat "矩形长宽列表如下:" (vl-princ-to-string jielst)))<br /> (setq lsthead  '("矩形长度" "宽度")<br />        tipstr "矩形长宽列表"       <br />        )<br /> (lst2csv lsthead tipstr jielst)<br /> (princ)<br /> )

fan_zh

感谢yjr111

加载时说输入的八进制符不正确，是什么原因？