[编程申请]：求助：屏幕数字平均的程序

hsb-hy

哪位老大帮忙编一个可以在屏幕上拾起两个数字并求其平均值，放在指定位置上得小程序？

david96007

可以选择一列数字,分别求出上下相邻两数字的平均值,然后在右侧35000处写出平均值!如果远了,你可以改程序中的35000,平均值文字的大小、图层同你选择的文本！
程序是ld用来计算土方的！

2. 
   
3. 
   
4. (defun c:pj (/ ssmj sslen n fangliang xx yy entmj x y str_fl)
   
5.   (princ "\n选择填挖面积:")
   
6.   (setq        ssmj  (ssget '((0 . "TEXT")))
   
7.         sslen (sslength ssmj)
   
8.         n     0
   
9.         yl    nil
   
10.   )
    
11.   (while (< n sslen)
    
12.     (setq yl (cons (caddr (assoc 10 (entget (ssname ssmj n)))) yl)
    
13.           n  (1+ n)
    
14.     )
    
15.   )
    
16.   (setq        n  0
    
17.         nl (vl-sort-i (reverse yl) '<)
    
18.   )
    
19.   (while (< n (- sslen 1))
    
20.     (setq nn n
    
21.           FangLiang 0
    
22.           xx 0
    
23.           yy 0
    
24.     )
    
25.     (repeat 2
    
26.       (setq entmj (entget (ssname ssmj (nth nn nl))))
    
27.       (setq mj (distof (cdr (assoc 1 entmj)))
    
28.             x  (cadr (assoc 10 entmj))
    
29.             y  (caddr (assoc 10 entmj))
    
30.       )
    
31.       (princ mj)
    
32.       (princ "\n")
    
33.       (setq fangliang (+ fangliang mj)
    
34.             yy              (+ yy y)
    
35.             xx              (+ xx x)
    
36.             nn              (1+ nn)
    
37.       )
    
38.     )
    
39.     (setq str_fl (rtos (/ fangliang 2) 2 2)
    
40.           yy         (/ yy 2)
    
41.           xx         (/ xx 2)
    
42.           xx         (+ xx 35000)
    
43.     )
    
44.     (setq entmj        (subst (cons 1 str_fl) (assoc 1 entmj) entmj)
    
45.           entmj        (subst (list 10 xx yy 0) (assoc 10 entmj) entmj)
    
46.     )
    
47.     (entmake entmj)
    
48.     (setq n (1+ n))
    
49.   )
    
50.   (princ)
    
51. )

<br /> <br /> (defun c:pj (/ ssmj sslen n fangliang xx yy entmj x y str_fl)<br />   (princ "\n选择填挖面积:")<br />   (setq        ssmj  (ssget '((0 . "TEXT")))<br />         sslen (sslength ssmj)<br />         n     0<br />         yl    nil<br />   )<br />   (while (< n sslen)<br />     (setq yl (cons (caddr (assoc 10 (entget (ssname ssmj n)))) yl)<br />           n  (1+ n)<br />     )<br />   )<br />   (setq        n  0<br />         nl (vl-sort-i (reverse yl) '<)<br />   )<br />   (while (< n (- sslen 1))<br />     (setq nn n<br />           FangLiang 0<br />           xx 0<br />           yy 0<br />     )<br />     (repeat 2<br />       (setq entmj (entget (ssname ssmj (nth nn nl))))<br />       (setq mj (distof (cdr (assoc 1 entmj)))<br />             x  (cadr (assoc 10 entmj))<br />             y  (caddr (assoc 10 entmj))<br />       )<br />       (princ mj)<br />       (princ "\n")<br />       (setq fangliang (+ fangliang mj)<br />             yy              (+ yy y)<br />             xx              (+ xx x)<br />             nn              (1+ nn)<br />       )<br />     )<br />     (setq str_fl (rtos (/ fangliang 2) 2 2)<br />           yy         (/ yy 2)<br />           xx         (/ xx 2)<br />           xx         (+ xx 35000)<br />     )<br />     (setq entmj        (subst (cons 1 str_fl) (assoc 1 entmj) entmj)<br />           entmj        (subst (list 10 xx yy 0) (assoc 10 entmj) entmj)<br />     )<br />     (entmake entmj)<br />     (setq n (1+ n))<br />   )<br />   (princ)<br /> )

hsb-hy

david96007,你好，谢谢你！我不懂编程，你给的程序如何应用，怎样在CAD中来调有它？请指点！

david96007

把压缩文件里的两个文件解压到acuocad的目录里(比如:C:\Program Files\AutoCAD R14),
启动cad后输入命令pj!

hsb-hy

你好，我使用了，还是没有用，选择后，屏幕没有什么反应！
我需要的是只要实现这样功能就行了。

在方格网中，如果我有20×20的方格网数据，现在要在改成10×10的方格网，就在没两个方格间加一个，取平均就好，老大能帮忙修改一下实现这功能吧！

如下图：在1和5间，求其平均值3。

david96007

我的程序是达到如下效果的:
和你的不太一样,我建议你耐下心来学习一下,这样的小程序只是适合自己用的!

hsb-hy

david96007,你好！我急需这样的一个程序，你能否帮忙编一个，我不会编程，麻烦你了！在此先谢谢了！

david96007

将你的其他情况说明一下,比如竖向的方格网是什么情况?

用下面的代码替换昨天下载的文件的内容,可以达到如下效果:

(r2000下通过!r14可能有问题!)

2. (defun c:pj (/ ssmj sslen n fangliang xx yy entmj x y str_fl)
   
3.   (princ "\n选择需要平均的数字:")
   
4.   (setq        ssmj  (ssget '((0 . "TEXT")))
   
5.         sslen (sslength ssmj)
   
6.         n     0
   
7.         yl    nil
   
8.   )
   
9.   (while (< n sslen)
   
10.     (setq yl (cons (cadr (assoc 10 (entget (ssname ssmj n)))) yl)
    
11.           n  (1+ n)
    
12.     )
    
13.   )
    
14.   (setq        n  0
    
15.         nl (vl-sort-i (reverse yl) '<)
    
16.   )
    
17.   (while (< n (- sslen 1))
    
18.     (setq nn n
    
19.           FangLiang 0
    
20.           xx 0
    
21.           yy 0
    
22.     )
    
23.     (repeat 2
    
24.       (setq entmj (entget (ssname ssmj (nth nn nl))))
    
25.       (setq mj (distof (cdr (assoc 1 entmj)))
    
26.             x  (cadr (assoc 10 entmj))
    
27.             y  (caddr (assoc 10 entmj))
    
28.       )
    
29.       (princ mj)
    
30.       (princ "\n")
    
31.       (setq fangliang (+ fangliang mj)
    
32.             yy              (+ yy y)
    
33.             xx              (+ xx x)
    
34.             nn              (1+ nn)
    
35.       )
    
36.     )
    
37.     (setq str_fl (rtos (/ fangliang 2) 2 2)
    
38.           yy         (/ yy 2)
    
39.           xx         (/ xx 2)
    
40. ;;;          xx         (+ xx 0)
    
41.     )
    
42.     (setq entmj        (subst (cons 1 str_fl) (assoc 1 entmj) entmj)
    
43.           entmj        (subst (list 10 xx yy 0) (assoc 10 entmj) entmj)
    
44.     )
    
45.     (entmake entmj)
    
46.     (setq n (1+ n))
    
47.   )
    
48.   (princ)
    
49. )

(defun c:pj (/ ssmj sslen n fangliang xx yy entmj x y str_fl)<br />   (princ "\n选择需要平均的数字:")<br />   (setq        ssmj  (ssget '((0 . "TEXT")))<br />         sslen (sslength ssmj)<br />         n     0<br />         yl    nil<br />   )<br />   (while (< n sslen)<br />     (setq yl (cons (cadr (assoc 10 (entget (ssname ssmj n)))) yl)<br />           n  (1+ n)<br />     )<br />   )<br />   (setq        n  0<br />         nl (vl-sort-i (reverse yl) '<)<br />   )<br />   (while (< n (- sslen 1))<br />     (setq nn n<br />           FangLiang 0<br />           xx 0<br />           yy 0<br />     )<br />     (repeat 2<br />       (setq entmj (entget (ssname ssmj (nth nn nl))))<br />       (setq mj (distof (cdr (assoc 1 entmj)))<br />             x  (cadr (assoc 10 entmj))<br />             y  (caddr (assoc 10 entmj))<br />       )<br />       (princ mj)<br />       (princ "\n")<br />       (setq fangliang (+ fangliang mj)<br />             yy              (+ yy y)<br />             xx              (+ xx x)<br />             nn              (1+ nn)<br />       )<br />     )<br />     (setq str_fl (rtos (/ fangliang 2) 2 2)<br />           yy         (/ yy 2)<br />           xx         (/ xx 2)<br /> ;;;          xx         (+ xx 0)<br />     )<br />     (setq entmj        (subst (cons 1 str_fl) (assoc 1 entmj) entmj)<br />           entmj        (subst (list 10 xx yy 0) (assoc 10 entmj) entmj)<br />     )<br />     (entmake entmj)<br />     (setq n (1+ n))<br />   )<br />   (princ)<br /> )

hsb-hy

你有QQ 吗？我的是359596849，我用QQ 向您请教好不？

如下图：左边的是20*20的方格网，在方格网加密后变成10*10的方格网如右图，现在要将右图中两个已有数据的中间方格网内填上一个数字，其值是上下两个数值的平均。从图面来看，所有的数值，不论是左右看还是上下看，都成一条直线。

david96007

我没有QQ!
你可以在这里发悄悄话呀!

hsb-hy

我给你申请一个，你稍等！

david96007

这个可以进行竖向文字的平均

2. 
   
3. (defun c:pjs (/ ssmj sslen n fangliang xx yy entmj x y str_fl)
   
4.   (princ "\n选择填挖面积:")
   
5.   (setq        ssmj  (ssget '((0 . "TEXT")))
   
6.         sslen (sslength ssmj)
   
7.         n     0
   
8.         yl    nil
   
9.   )
   
10.   (while (< n sslen)
    
11.     (setq yl (cons (caddr (assoc 10 (entget (ssname ssmj n)))) yl)
    
12.           n  (1+ n)
    
13.     )
    
14.   )
    
15.   (setq        n  0
    
16.         nl (vl-sort-i (reverse yl) '<)
    
17.   )
    
18.   (while (< n (- sslen 1))
    
19.     (setq nn n
    
20.           FangLiang 0
    
21.           xx 0
    
22.           yy 0
    
23.     )
    
24.     (repeat 2
    
25.       (setq entmj (entget (ssname ssmj (nth nn nl))))
    
26.       (setq mj (distof (cdr (assoc 1 entmj)))
    
27.             x  (cadr (assoc 10 entmj))
    
28.             y  (caddr (assoc 10 entmj))
    
29.       )
    
30.       (princ mj)
    
31.       (princ "\n")
    
32.       (setq fangliang (+ fangliang mj)
    
33.             yy              (+ yy y)
    
34.             xx              (+ xx x)
    
35.             nn              (1+ nn)
    
36.       )
    
37.     )
    
38.     (setq str_fl (rtos (/ fangliang 2) 2 2)
    
39.           yy         (/ yy 2)
    
40.           xx         (/ xx 2)
    
41.     )
    
42.     (setq entmj        (subst (cons 1 str_fl) (assoc 1 entmj) entmj)
    
43.           entmj        (subst (list 10 xx yy 0) (assoc 10 entmj) entmj)
    
44.     )
    
45.     (entmake entmj)
    
46.     (setq n (1+ n))
    
47.   )
    
48.   (princ)
    
49. )
    

<br /> (defun c:pjs (/ ssmj sslen n fangliang xx yy entmj x y str_fl)<br />   (princ "\n选择填挖面积:")<br />   (setq        ssmj  (ssget '((0 . "TEXT")))<br />         sslen (sslength ssmj)<br />         n     0<br />         yl    nil<br />   )<br />   (while (< n sslen)<br />     (setq yl (cons (caddr (assoc 10 (entget (ssname ssmj n)))) yl)<br />           n  (1+ n)<br />     )<br />   )<br />   (setq        n  0<br />         nl (vl-sort-i (reverse yl) '<)<br />   )<br />   (while (< n (- sslen 1))<br />     (setq nn n<br />           FangLiang 0<br />           xx 0<br />           yy 0<br />     )<br />     (repeat 2<br />       (setq entmj (entget (ssname ssmj (nth nn nl))))<br />       (setq mj (distof (cdr (assoc 1 entmj)))<br />             x  (cadr (assoc 10 entmj))<br />             y  (caddr (assoc 10 entmj))<br />       )<br />       (princ mj)<br />       (princ "\n")<br />       (setq fangliang (+ fangliang mj)<br />             yy              (+ yy y)<br />             xx              (+ xx x)<br />             nn              (1+ nn)<br />       )<br />     )<br />     (setq str_fl (rtos (/ fangliang 2) 2 2)<br />           yy         (/ yy 2)<br />           xx         (/ xx 2)<br />     )<br />     (setq entmj        (subst (cons 1 str_fl) (assoc 1 entmj) entmj)<br />           entmj        (subst (list 10 xx yy 0) (assoc 10 entmj) entmj)<br />     )<br />     (entmake entmj)<br />     (setq n (1+ n))<br />   )<br />   (princ)<br /> )<br />

hsb-hy

更改后，运行PJ，屏幕还是没有任何反应!九楼的图就是我的要求，你看看能否满足？

david96007

我自己用没有问题啊!

QQ已经安装完毕!怎么联系不上你呀?!

啵浪鼓

david96007,你的Q号是多少,我加你