按块选择功能

winerfjy

1. (defun c:ak(/ a ss b c d)；按块选择功能
   
2. (setvar "cmdecho" 0)
   
3. (princ "\n选择要选的块样")
   
4. (setq a(cdr (assoc 2 (entget (car (entsel))))))
   
5. (setq d(substr a 1 1));到得第一个数
   
6.   (if (= "*" d)
   
7.   (setq c(strcat "`" a))(setq c a))
   
8. (setq b (uINT 1 "" "1.手选范围，2.全图选中" 1))
   
9.   (if (= 1 b)
   
10.     (prompt "\n选择一个区域:"))
    
11.   (if (= 1 b)
    
12.   (SETQ ss (ssget (list '(0 . "INSERT")(cons 2 c)))))
    
13.   (if (= 2 b)
    
14. (SETQ ss(ssget "x"(list '(0 . "INSERT")(cons 2 c)))))
    
15. (sssetfirst nil ss)
    
16. (princ  (STRCAT "共有图块" (ITOA(SSLENGTH ss))"个"))
    
17. (prin1)
    
18. (princ))
    
19. (defun uint (bit kwd msg def / inp)
    
20.   (if def
    
21.     (setq msg (strcat "\n" msg "<" (itoa def) ">:") ;Test for a default
    
22.     bit (- bit (boole 1 bit 1))  ; A default and no null bit code
    
23.     )          ;setq
    
24.     (if  (= "" (substr msg (strlen msg) 1))
    
25.       (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ":"))
    
26.           ;Then strip space
    
27.           ;else msg is OK
    
28.       (setq msg (strcat "\n" msg ":"))
    
29.     )
    
30.   )          ;if,if
    
31.   (initget bit kwd)
    
32.   (setq inp (getint msg))
    
33.   (if inp
    
34.     inp
    
35.     def
    
36.   )
    
37. )  
    

(defun c:ak(/ a ss b c d)；按块选择功能<br /> (setvar "cmdecho" 0)<br /> (princ "\n选择要选的块样")<br /> (setq a(cdr (assoc 2 (entget (car (entsel))))))<br /> (setq d(substr a 1 1));到得第一个数<br />   (if (= "*" d)<br />   (setq c(strcat "`" a))(setq c a))<br /> (setq b (uINT 1 "" "1.手选范围，2.全图选中" 1))<br />   (if (= 1 b)<br />     (prompt "\n选择一个区域:"))<br />   (if (= 1 b)<br />   (SETQ ss (ssget (list '(0 . "INSERT")(cons 2 c)))))<br />   (if (= 2 b)<br /> (SETQ ss(ssget "x"(list '(0 . "INSERT")(cons 2 c)))))<br /> (sssetfirst nil ss)<br /> (princ  (STRCAT "共有图块" (ITOA(SSLENGTH ss))"个"))<br /> (prin1)<br /> (princ))<br /> (defun uint (bit kwd msg def / inp)<br />   (if def<br />     (setq msg (strcat "\n" msg "<" (itoa def) ">:") ;Test for a default<br />     bit (- bit (boole 1 bit 1))  ; A default and no null bit code<br />     )          ;setq<br />     (if  (= "" (substr msg (strlen msg) 1))<br />       (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ":"))<br />           ;Then strip space<br />           ;else msg is OK<br />       (setq msg (strcat "\n" msg ":"))<br />     )<br />   )          ;if,if<br />   (initget bit kwd)<br />   (setq inp (getint msg))<br />   (if inp<br />     inp<br />     def<br />   )<br /> )  <br />

113486295

高手啊能不能修改成选择特定的匿名块

bluefcc1

下載學習..

113486295

能不能修改成选择特定的匿名块

疯球

真心感觉高手的分享

winerfjy

疯球 发表于 2018-5-14 16:30
真心感觉高手的分享

很久没有上论坛了都是刚学lisp的时候拿得出手的东西

alexmai

可否改进一下，对动态块也适用


资料参考：
http://bbs.mjtd.com/forum.php?mo ... ht=ssget&page=2