28楼已改，再试试。
非常感谢ZZXXQQ的帮忙，程序已经可以运行。但是生成的符号与原来的圆是在同一层下，如果要打印的话就看不清了，麻烦ZZXXQQ帮忙修正一下，把生成的符号放到一个新的层下，还有就是能不能把统计符号的和生成符号的两个程序融为一个命令使用？等待中..........
;圆分色按大小填标记号并统计 明经 ZZXXQQ 2008.1.19 2008.1.20
(defun c:tt ()
(setvar "CMDECHO" 0)
(setq oldla (getvar "CLAYER"))
(setq oldzin (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(princ "\nSelect Circle(s) 选择圆 :")
(if (setq ss (ssget '((0 . "CIRCLE")))) (progn
(setq equ (getdist "\nInput equalize 补偿值 :"))
(command ".UNDO" "BE")
(setq i -1cirlst (list))
(repeat (sslength ss)
(setq r (cdr (assoc 40 (entget (setq en (ssname ss (setq i (1+ i))))))))
(if (assoc r cirlst)
(setq cirlst (subst (cons r (1+ (cdr (assoc r cirlst)))) (assoc r cirlst) cirlst))
(setq cirlst (cons (cons r 1) cirlst))
)
)
(setq i -1 cirlst (reverse cirlst))
(setq dwglst (list "1" "2" "3" "4" "5" "9" "10" "11" "18" "20" "24" "25" "26" "28" "31" "32"
"34" "35" "38" "39" "40" "41" "42" "44"))
(setq cirlst (vl-sort cirlst (function (lambda (e1 e2) (< (car e1) (car e2))))))
(repeat (length cirlst)
(setq r (car (nth (setq i (1+ i)) cirlst)))
(command "select" ss "")
(setq ss1 (ssget "P" (list (cons 0 "CIRCLE") (cons 40 r))))
(command "chprop" ss1 "" "C" (itoa (1+ i)) "")
(if (setq bnm (findfile (strcat (nth i dwglst) ".dwg"))) (progn
(setq j 0)
(setq pc (cdr(assoc 10 (entget(ssname ss1 0)))))
(command "-insert" bnm pc "" "" "" "chprop" "l" "" "C" (itoa (1+ i)) "")
(setq bnm (nth i dwglst))
(command "layer" "n" "item" "")
(repeat (1- (sslength ss1))
(setq pc (cdr (assoc 10 (entget(ssname ss1 (setq j (1+ j)))))))
(command "-insert" bnm pc "" "" "" "chprop" "l" "" "C" (itoa (1+ i)) "")
)
(setvar "CLAYER" oldla)
))
)
(IF (SETQ PT (GETPOINT "\nTab Start Point :")) (PROGN
(COMMAND "TEXT" PT 2.5 0 "序号 符号 孔径 针径 数量")
(SETQ K -1
PT (POLAR (POLAR PT (/ PI -2) 6) 0 2)
SUM 0
LL (length cirlst)
cirlst (reverse cirlst))
(REPEAT LL
(SETQ L (NTH (SETQ K (1+ K)) cirlst))
(COMMAND "TEXT" PT 2.5 0 (ITOA (- LL K)))
(COMMAND "-INSERT" (nth (- ll k 1) dwglst) (POLAR (POLAR PT 0 10) (/ PI 2) 1) 1 1 0)
(COMMAND "CHPROP" "L" "" "C" (itoa (- ll k)) "")
(COMMAND "TEXT" (SETQ PT1 (POLAR PT 0 18)) 2.5 0 (rtos (* (car l) 2) 2 3))
(COMMAND "TEXT" (SETQ PT1 (POLAR PT1 0 12)) 2.5 0 (rtos (+ (* (car l) 2) equ) 2 2))
(COMMAND "TEXT" (POLAR PT1 0 12) 2.5 0 (itoa (cdr L)))
(SETQ PT (POLAR PT (/ PI -2) 5)
SUM (+ SUM (cdr L)))
)
(COMMAND "TEXT" (POLAR (POLAR PT 0 18) (/ PI -2) 5) 2.5 0 "总 和")
(COMMAND "TEXT" (POLAR (POLAR PT 0 42) (/ PI -2) 5) 2.5 0 (ITOA SUM))
))
(command ".UNDO" "E")
))
(setvar "DIMZIN" oldzin)
(setvar "CMDECHO" 1)
(princ)
)
唉
本帖最后由 作者 于 2008-1-20 19:01:55 编辑 <br /><br /> <p><strong><font face="Verdana" color="#61b713">多谢ZZXXQQ的大力帮忙和热心帮助,呵^^^^^真是大好人.</font></strong></p><p><font face="Verdana" color="#61b713"><strong>????sailorcwx为何</strong><font color="#000000">唉声叹气/?呵^^^^^^^^^^^</font></font></p>
<p>我只是觉得这个帖子很熟悉。如果我没有猜错，楼主在这个论坛应该有N多个马甲，而这个功能就我本人都见过你发了三次</p><p>第一次是在这个版的，当时你也是要求zzxxqq帮你的，不过没人理你，我多事帮你写了，也按你的要求修改了程序几次。但是后来帖子莫名其妙的不见了</p><p>第二次是在编程技术版的，我当时骂了你，责怪你把那个帖子删了。</p><p>现在是第三次。看着都不是滋味。</p>
<p>呵%%兄弟你可能误会了,我刚进来论坛不久,并且我也是在这里第一次发请求编程,</p><p>想不到被你误解了.对不起,呵%%</p><p>没想到第一次发贴会被人误会我是"黄牛党"呢,以后我会小心了,嘻&&&&</p>
<p>我在明经获益非浅..在<strong><font face="Verdana" color="#61b713">明经的技术好肯帮人真的很多.... 谢谢...</font></strong></p><p><font face="Verdana" color="#61b713"><strong>见到</strong><font face="Verdana" color="#61b713"><strong>sailorcwx兄的话,对</strong><font face="Verdana" color="#61b713"><strong>sailorcwx兄说的人只有二个字:鄙视 (本人并不敢肯定是不是楼主)</strong></font></font></font></p>
很好用谢谢楼主及楼上的朋友
<p>还有一个小小的要求 就是能统计相同圆的个数再列表出来 如%%C2.5 2(个) 谢谢 如果有X座标 Y座标 就更好 没有也没关系 这论坛里有统计圆大小和座标的LISP </p>