[分享]：刚些的一个点选等分块分布代码

snsj

2. 
   
3. ;;;点选等分插入块命令
   
4. ;;;主要针对DIVIDE命令等分插入块时，需要输入块名的不便
   
5. ;;;此代码可以直接点选图中已有块进行分布
   
6. ;;;也可以利用选择集选择非块物体的集合或者块与非块物体的集合
   
7. ;;;然后将集合转化为块后进行平均分布块
   
8. ;;;制作:snsj
   
9. ;;;apple_dfk.lsp
   
10. (defun c:dfk ()
    
11.   (initget "A")
    
12.   (setq a (getkword "\n点选图中已有块<回车键>/选择非块物体或块与单体的组合按<a>:"))
    
13.   (cond
    
14.     ((null a)
    
15.      (setq a1 (entsel "\n选择要等分的线:"))
    
16.       (cond
    
17.         ((null a1) (exit))
    
18.         )
    
19.      (setq a2 (entsel "\n选择要分布等分点的块:"))
    
20.      (cond
    
21.        ((null a2) (exit))
    
22.        )
    
23.      (setq a4 (cdr (assoc 2 (entget (car a2)))))
    
24.      (initget 1 "Y N")
    
25.      (setq a5 (getkword "是否对齐块对象？[是<Y>/否<N>]:"))
    
26.      (command ".divide" a1 "b" a4 a5)   
    
27.     )     
    
28.     (t
    
29.      (setq a1 (entsel "\n选择要等分的线:"))
    
30.      (cond
    
31.         ((null a1) (exit))
    
32.         )
    
33.        (setq ss (ssget))
    
34.      (cond
    
35.         ((null ss) (exit))
    
36.         )
    
37.      (setq pt1 (getpoint "\n请输入基点:"))
    
38.      (cond
    
39.         ((null pt1) (exit))
    
40.         )
    
41.        (setq jdz t
    
42.              kj nil
    
43.        )
    
44.        (while (setq e (tblnext "block" jdz))
    
45.          (setq na (cdr (assoc 2 e))
    
46.                jdz nil
    
47.          )
    
48.          (setq kj (cons na kj))
    
49.        )
    
50.       
    
51.        (setq kj1 nil)
    
52.        (mapcar
    
53.          '(lambda (x)
    
54.             (if(not(wcmatch x "[~apple'-]*"))
    
55.               (setq kj1 (cons x kj1))
    
56.             )
    
57.           )
    
58.          kj
    
59.        )      
    
60.        (cond
    
61.          ((null kj1)
    
62.           (setq kj1 "apple-0")
    
63.           (setq nb kj1)
    
64.          )
    
65.          (t (setq zx (car(reverse(acad_strlsort kj1))))
    
66.           (setq        ds (atoi (vl-string-left-trim "apple-" zx))
    
67.           )
    
68.           (setq jy (+ ds 1))
    
69.           (setq nb (strcat "apple-" (itoa jy)))
    
70.           )
    
71.          )
    
72.           (command ".block" nb  pt1 ss "")
    
73.           (command ".divide" a1 "b" nb)  
    
74.          )
    
75.        )
    
76.      )
    
77.    
    

<br /> ;;;点选等分插入块命令<br /> ;;;主要针对DIVIDE命令等分插入块时，需要输入块名的不便<br /> ;;;此代码可以直接点选图中已有块进行分布<br /> ;;;也可以利用选择集选择非块物体的集合或者块与非块物体的集合<br /> ;;;然后将集合转化为块后进行平均分布块<br /> ;;;制作:snsj <br /> ;;;apple_dfk.lsp<br /> (defun c:dfk ()<br />   (initget "A")<br />   (setq a (getkword "\n点选图中已有块<回车键>/选择非块物体或块与单体的组合按<a>:"))<br />   (cond<br />     ((null a)<br />      (setq a1 (entsel "\n选择要等分的线:"))<br />       (cond<br />         ((null a1) (exit))<br />         )<br />      (setq a2 (entsel "\n选择要分布等分点的块:"))<br />      (cond<br />        ((null a2) (exit))<br />        )<br />      (setq a4 (cdr (assoc 2 (entget (car a2)))))<br />      (initget 1 "Y N")<br />      (setq a5 (getkword "是否对齐块对象？[是<Y>/否<N>]:"))<br />      (command ".divide" a1 "b" a4 a5)    <br />     )     <br />     (t<br />      (setq a1 (entsel "\n选择要等分的线:"))<br />      (cond<br />         ((null a1) (exit))<br />         )<br />        (setq ss (ssget))<br />      (cond<br />         ((null ss) (exit))<br />         )<br />      (setq pt1 (getpoint "\n请输入基点:"))<br />      (cond<br />         ((null pt1) (exit))<br />         )<br />        (setq jdz t<br />              kj nil<br />        )<br />        (while (setq e (tblnext "block" jdz))<br />          (setq na (cdr (assoc 2 e))<br />                jdz nil<br />          )<br />          (setq kj (cons na kj))<br />        )<br />       <br />        (setq kj1 nil)<br />        (mapcar<br />          '(lambda (x)<br />             (if(not(wcmatch x "[~apple'-]*"))<br />               (setq kj1 (cons x kj1))<br />             )<br />           )<br />          kj<br />        )       <br />        (cond<br />          ((null kj1)<br />           (setq kj1 "apple-0")<br />           (setq nb kj1)<br />          )<br />          (t (setq zx (car(reverse(acad_strlsort kj1))))<br />           (setq        ds (atoi (vl-string-left-trim "apple-" zx))<br />           )<br />           (setq jy (+ ds 1))<br />           (setq nb (strcat "apple-" (itoa jy)))<br />           )<br />          )<br />           (command ".block" nb  pt1 ss "")<br />           (command ".divide" a1 "b" nb)  <br />          )<br />        )<br />      )<br />     <br />

求各位高手多多指教