好久没上论坛了,突发其想: 相同直径改为相同颜色

小陶

伪源码！代码相当长，估计也只有我自己才看行懂！;P不敢摆出来

ysq101

小陶 发表于 2013-10-12 11:32
伪源码！代码相当长，估计也只有我自己才看行懂！不敢摆出来

汗..不想共享是吗??那发我邮箱好了{:soso_e100:}

120389613@qq.com

小陶

ysq101 发表于 2013-10-12 13:45
汗..不想共享是吗??那发我邮箱好了

;变色分孔 孔按大小分类，以颜色区分

1. (defun c:bsfk (/ TT1 SS I LST NAME R TMP TMP_NEW SS1 PT1 ZJ LST1 LEN)
   
2.   (defun tt1 (pt col /)
   
3.     (TAO-make-lwpolyline
   
4.       (list  pt
   
5.             (list (car pt) (- (cadr pt) 12))
   
6.             (list (+ (car pt) 6) (- (cadr pt) 12))
   
7.             (list (+ (car pt) 6) (cadr pt))
   
8.       )
   
9.       1
   
10.       256
    
11.       "DIM"
    
12.     )
    
13.     (setq ss1 (ssadd (entlast) ss1))
    
14.     (tao-make-line
    
15.       (list (car pt) (- (cadr pt) 4))
    
16.       (list (+ (car pt) 6) (- (cadr pt) 4))
    
17.     )
    
18.     (setq ss1 (ssadd (entlast) ss1))
    
19.     (tao-make-line
    
20.       (list (car pt) (- (cadr pt) 8))
    
21.       (list (+ (car pt) 6) (- (cadr pt) 8))
    
22.     )
    
23.     (setq ss1 (ssadd (entlast) ss1))
    
24.     (command "SOLID"
    
25.              (trans pt 0 1)
    
26.              (trans(list (+ (car pt) 6) (cadr pt))0 1)
    
27.              (trans(list (car pt) (- (cadr pt) 4))0 1)
    
28.              (trans(list (+ (car pt) 6) (- (cadr pt) 4))0 1)
    
29.              ""
    
30.     )
    
31.     (setq ss1 (ssadd (entlast) ss1))
    
32.     (xyp-SubUpd (entlast) 62 col)
    
33.     (command "SCALE"
    
34.              (entlast)
    
35.              ""
    
36.              (trans (tao-get-name-maxminpoint (entlast) 5) 0 1)
    
37.              0.9
    
38.     )
    
39.     (TAO-MAKE-TEXT
    
40.       (list (+ (car pt) 3) (- (cadr pt) 6))
    
41.       (rtos zj 2 2)
    
42.       1
    
43.       1.5
    
44.       "宋体"
    
45.     )
    
46.     (setq ss1 (ssadd (entlast) ss1))
    
47.     (TAO-MAKE-TEXT
    
48.       (list (+ (car pt) 3) (- (cadr pt) 10))
    
49.       (rtos len 2)
    
50.       1
    
51.       2
    
52.       "宋体"
    
53.     )
    
54.     (setq ss1 (ssadd (entlast) ss1))
    
55.     (setq pt1 (polar pt 0 6))
    
56.   )
    
57. 
    
58.   (if (setq ss (ssget '((0 . "CIRCLE"))))
    
59.     (progn
    
60.       (err-set
    
61.         (list '("cmdecho" 0 "cecolor" "bylayer" "clayer" "0") 0 nil)
    
62.       )
    
63.       (TAO-MAKE-LAYER "DIM" 3)
    
64.       (TAO-MAKE-TEXTSTYLE "宋体" "宋体")
    
65.       (setq i        -1
    
66.             lst        '()
    
67.       )
    
68.       (while (setq name (ssname ss (setq i (1+ i))))
    
69.         (setq r (dxf 40 name))
    
70.         (if (setq TMP (assoc R LST))
    
71.           (setq        TMP_NEW        (cons R (cons name (cdr TMP)))
    
72.                 LST        (subst TMP_NEW TMP LST)
    
73.           )
    
74.           (setq LST (cons (list R name) LST))
    
75.         )
    
76.       )
    
77.       (setq LST        (vl-sort LST
    
78.                          (function (lambda (e1 e2)
    
79.                                      (< (car e1) (car e2))
    
80.                                    )
    
81.                          )
    
82.                 )
    
83.       )
    
84.       (setq i        0
    
85.             ss1        (ssadd)
    
86.       )
    
87.       (TAO-make-lwpolyline
    
88.         (list '(0 0) '(0 -12) '(8 -12) '(8 0))
    
89.         1
    
90.         256
    
91.         "DIM"
    
92.       )
    
93.       (setq ss1 (ssadd (entlast) ss1))
    
94.       (tao-make-line '(0 -4) '(8 -4))
    
95.       (setq ss1 (ssadd (entlast) ss1))
    
96.       (tao-make-line '(0 -8) '(8 -8))
    
97.       (setq ss1 (ssadd (entlast) ss1))
    
98.       (TAO-MAKE-TEXT (list 4 -2) "颜色" 1 2 "宋体")
    
99.       (setq ss1 (ssadd (entlast) ss1))
    
100.       (TAO-MAKE-TEXT (list 4 -6) "直径" 1 2 "宋体")
     
101.       (setq ss1 (ssadd (entlast) ss1))
     
102.       (TAO-MAKE-TEXT (list 4 -10) "数量" 1 2 "宋体")
     
103.       (setq ss1 (ssadd (entlast) ss1))
     
104.       (setq pt1 '(8 0))
     
105.       (foreach n LST
     
106.         (setq i           (1+ i)
     
107.               zj   (* (car n) 2)
     
108.               lst1 (cdr n)
     
109.               len  (length lst1)
     
110.         )
     
111.         (foreach n1 lst1
     
112.           (xyp-SubUpd n1 62 i)
     
113.         )
     
114.         (tt1 pt1 i)
     
115.       )
     
116.       (tao-move ss1 (trans (list 0 0) 0 1))
     
117.       (err-res)
     
118.     )
     
119.     (princ)
     
120.   )
     
121. )
     

(defun c:bsfk (/ TT1 SS I LST NAME R TMP TMP_NEW SS1 PT1 ZJ LST1 LEN)<br />   (defun tt1 (pt col /)<br />     (TAO-make-lwpolyline<br />       (list  pt<br />             (list (car pt) (- (cadr pt) 12))<br />             (list (+ (car pt) 6) (- (cadr pt) 12))<br />             (list (+ (car pt) 6) (cadr pt))<br />       )<br />       1<br />       256<br />       "DIM"<br />     )<br />     (setq ss1 (ssadd (entlast) ss1))<br />     (tao-make-line<br />       (list (car pt) (- (cadr pt) 4))<br />       (list (+ (car pt) 6) (- (cadr pt) 4))<br />     )<br />     (setq ss1 (ssadd (entlast) ss1))<br />     (tao-make-line<br />       (list (car pt) (- (cadr pt) 8))<br />       (list (+ (car pt) 6) (- (cadr pt) 8))<br />     )<br />     (setq ss1 (ssadd (entlast) ss1))<br />     (command "SOLID"<br />              (trans pt 0 1)<br />              (trans(list (+ (car pt) 6) (cadr pt))0 1)<br />              (trans(list (car pt) (- (cadr pt) 4))0 1)<br />              (trans(list (+ (car pt) 6) (- (cadr pt) 4))0 1)<br />              ""<br />     )<br />     (setq ss1 (ssadd (entlast) ss1))<br />     (xyp-SubUpd (entlast) 62 col)<br />     (command "SCALE"<br />              (entlast)<br />              ""<br />              (trans (tao-get-name-maxminpoint (entlast) 5) 0 1)<br />              0.9<br />     )<br />     (TAO-MAKE-TEXT<br />       (list (+ (car pt) 3) (- (cadr pt) 6))<br />       (rtos zj 2 2)<br />       1<br />       1.5<br />       "宋体"<br />     )<br />     (setq ss1 (ssadd (entlast) ss1))<br />     (TAO-MAKE-TEXT<br />       (list (+ (car pt) 3) (- (cadr pt) 10))<br />       (rtos len 2)<br />       1<br />       2<br />       "宋体"<br />     )<br />     (setq ss1 (ssadd (entlast) ss1))<br />     (setq pt1 (polar pt 0 6))<br />   )<br /> <br />   (if (setq ss (ssget '((0 . "CIRCLE"))))<br />     (progn<br />       (err-set<br />         (list '("cmdecho" 0 "cecolor" "bylayer" "clayer" "0") 0 nil)<br />       )<br />       (TAO-MAKE-LAYER "DIM" 3)<br />       (TAO-MAKE-TEXTSTYLE "宋体" "宋体")<br />       (setq i        -1<br />             lst        '()<br />       )<br />       (while (setq name (ssname ss (setq i (1+ i))))<br />         (setq r (dxf 40 name))<br />         (if (setq TMP (assoc R LST))<br />           (setq        TMP_NEW        (cons R (cons name (cdr TMP)))<br />                 LST        (subst TMP_NEW TMP LST)<br />           )<br />           (setq LST (cons (list R name) LST))<br />         )<br />       )<br />       (setq LST        (vl-sort LST<br />                          (function (lambda (e1 e2)<br />                                      (< (car e1) (car e2))<br />                                    )<br />                          )<br />                 )<br />       )<br />       (setq i        0<br />             ss1        (ssadd)<br />       )<br />       (TAO-make-lwpolyline<br />         (list '(0 0) '(0 -12) '(8 -12) '(8 0))<br />         1<br />         256<br />         "DIM"<br />       )<br />       (setq ss1 (ssadd (entlast) ss1))<br />       (tao-make-line '(0 -4) '(8 -4))<br />       (setq ss1 (ssadd (entlast) ss1))<br />       (tao-make-line '(0 -8) '(8 -8))<br />       (setq ss1 (ssadd (entlast) ss1))<br />       (TAO-MAKE-TEXT (list 4 -2) "颜色" 1 2 "宋体")<br />       (setq ss1 (ssadd (entlast) ss1))<br />       (TAO-MAKE-TEXT (list 4 -6) "直径" 1 2 "宋体")<br />       (setq ss1 (ssadd (entlast) ss1))<br />       (TAO-MAKE-TEXT (list 4 -10) "数量" 1 2 "宋体")<br />       (setq ss1 (ssadd (entlast) ss1))<br />       (setq pt1 '(8 0))<br />       (foreach n LST<br />         (setq i           (1+ i)<br />               zj   (* (car n) 2)<br />               lst1 (cdr n)<br />               len  (length lst1)<br />         )<br />         (foreach n1 lst1<br />           (xyp-SubUpd n1 62 i)<br />         )<br />         (tt1 pt1 i)<br />       )<br />       (tao-move ss1 (trans (list 0 0) 0 1))<br />       (err-res)<br />     )<br />     (princ)<br />   )<br /> )<br />

金鹅起飞

小陶 发表于 2013-10-13 22:36
;变色分孔 孔按大小分类，以颜色区分

下载后加载运行，出现：错误: no function definition: ERR-SET，求解。谢谢！

freeok2013

搞不出来。。。:lol