[LISP程序]：图块修改工具lsp: 改块/X左右镜相/Y前后镜相/Z值/V新尺寸/S放缩

梦断江南

2. 
   
3.   [FONT=courier new]
   
4. ;block edit; N改块/X左右镜相/Y前后镜相/Z值/V新尺寸/S放缩   ------lxx.97.4[2001.2m]
   
5. ;dwall can be stretch at the same time when V
   
6. ;tblsearch;cond;ucs
   
7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
8. ;;;;;;;;;;;;;;;;;------chb-------;;;;;;;;;;;;;;;;;;;;;;;;;;;main
   
9. (defun c:chb (/ ss n i kw nvl sc)
   
10. (princ "\nchb--block块修改工具------------------lxx.97.4[2001.2m]")
    
11. ;  (COMMAND "UCS" "" "PLAN" "")
    
12.   (chb1)                          ;;;;---chb1
    
13.   (setvar "osmode" 0)
    
14.   (setq ss(ssget)
    
15.         n (sslength ss)
    
16.         i 0)
    
17.   (repeat n
    
18.     (setq ent (entget (ssname ss i) '("*")) i (+ 1 i))
    
19.     (if (or (= "INSERT" (cdr (assoc 0 ent)))
    
20.             (= "attrib" (cdr (assoc 0 ent)))) (chb2));;;---chb2
    
21.   )(princ)
    
22. )
    
23. ;;;;;;;;;;;;;;;;;;;;;-------chb1--------;;;;;;;;;;;;;;;;;;;;;;;;;
    
24. (defun chb1 ( )
    
25.   (initget "N X Y Z V S")
    
26.   (setq kw (strcase(getkword "\nN改块/X左右镜相/Y前后镜相/Z值/V插入比例/S放缩:")))
    
27.   (cond ((= "N" kw) (progn (setq cod 2 nval (getstring "\n 替换为块？:"))
    
28.                      (if (null (tblsearch "block" nval)) (progn (command "insert" nval)(command)))
    
29.                     ))
    
30.         ((= "X" kw) (setq cod 41))
    
31.         ((= "Y" kw) (setq cod 42))
    
32.         ((= "Z" kw) (setq cod 43 nval (getdist "\n z 值:")))
    
33.         ((= "V" kw) (setq cod 41 nvl (getdist "\n 插入比例:")))
    
34.         ((= "S" kw) (setq cod 41 sc (getdist "\n scale比例:")))
    
35. )  )
    
36. ;;;;;;;;;;;;;;;;;-------chb2--------;;;;;;;;;;;;;;;;
    
37. (defun chb2 (/ oe nent ipt ang pt1 pt2 p1 p2)      ;nval
    
38.   (setq oe (assoc cod ent) val (cdr oe))
    
39.   (cond
    
40.         ((= "N" kw)(princ "\nOK!"))
    
41.         ((= "X" kw)(setq nval (- 0 VAL)))
    
42.         ((= "Y" kw)(setq nval (- 0 VAL)))
    
43.         ((= "Z" kw)(princ "\nOK!"))
    
44.         ((= "V" kw)(setq nval (/ (* val nvl) (abs val))
    
45.                          ipt (cdr (assoc 10 ent)) ang (cdr (assoc 50 ent)))
    
46.                    (COMMAND "UCS" "")             ;MUST LINE
    
47.                    (setvar "osmode" 0)
    
48.                    (setq pt1 (polar ipt ang val) anp (/ pi 20)
    
49.                          pt2 (polar ipt ang nval)
    
50.                          p1 (polar pt1 (+ (+ ang (/ pi 2)) anp) 200)
    
51.                          p2 (polar pt1 (+ (- ang (/ pi 2)) anp) 200)))
    
52.         ((= "S" kw)(setq nval (* sc VAL)))
    
53.   )     
    
54.   (setq nent (subst (cons cod nval) oe ent)) (entmod nent)
    
55.   (if (or (= "V" kw) (= "S" kw))                                     ;y value
    
56.       (if(/= "C" (cdr (assoc 2 ent)))
    
57.       (progn  (setq oe (assoc 42 nent) val (cdr oe))
    
58.         (if(= "V" kw)(setq nval (/ (* val nvl) (abs val))))
    
59.         (if(= "S" kw)(setq nval (* sc VAL)))
    
60.         (setq nent (subst (cons 42 nval) oe nent))
    
61.         (entmod nent)
    
62.   )   ))
    
63.   (if (= "V" kw)
    
64.       (command "_stretch" "c" p1 p2 "" pt1 pt2)  
    
65. ) )
    
66. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;end
    
67. (princ "\n   chb---block块修改工具------------------lxx.97.4[2001.2m]")(princ)
    
68.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;block edit; N改块/X左右镜相/Y前后镜相/Z值/V新尺寸/S放缩   ------lxx.97.4[2001.2m]<br /> ;dwall can be stretch at the same time when V<br /> ;tblsearch;cond;ucs<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;;;;;;;;;;;;;;;;;------chb-------;;;;;;;;;;;;;;;;;;;;;;;;;;;main<br /> (defun c:chb (/ ss n i kw nvl sc)<br /> (princ "\nchb--block块修改工具------------------lxx.97.4[2001.2m]")<br /> ;  (COMMAND "UCS" "" "PLAN" "")<br />   (chb1)                          ;;;;---chb1<br />   (setvar "osmode" 0)<br />   (setq ss(ssget)<br />         n (sslength ss)<br />         i 0)<br />   (repeat n<br />     (setq ent (entget (ssname ss i) '("*")) i (+ 1 i))<br />     (if (or (= "INSERT" (cdr (assoc 0 ent)))<br />             (= "attrib" (cdr (assoc 0 ent)))) (chb2));;;---chb2<br />   )(princ)<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;-------chb1--------;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun chb1 ( )<br />   (initget "N X Y Z V S")<br />   (setq kw (strcase(getkword "\nN改块/X左右镜相/Y前后镜相/Z值/V插入比例/S放缩:")))<br />   (cond ((= "N" kw) (progn (setq cod 2 nval (getstring "\n 替换为块？:"))<br />                      (if (null (tblsearch "block" nval)) (progn (command "insert" nval)(command)))<br />                     ))<br />         ((= "X" kw) (setq cod 41))<br />         ((= "Y" kw) (setq cod 42))<br />         ((= "Z" kw) (setq cod 43 nval (getdist "\n z 值:")))<br />         ((= "V" kw) (setq cod 41 nvl (getdist "\n 插入比例:")))<br />         ((= "S" kw) (setq cod 41 sc (getdist "\n scale比例:")))<br /> )  )<br /> ;;;;;;;;;;;;;;;;;-------chb2--------;;;;;;;;;;;;;;;;<br /> (defun chb2 (/ oe nent ipt ang pt1 pt2 p1 p2)      ;nval<br />   (setq oe (assoc cod ent) val (cdr oe))<br />   (cond <br />         ((= "N" kw)(princ "\nOK!"))<br />         ((= "X" kw)(setq nval (- 0 VAL)))<br />         ((= "Y" kw)(setq nval (- 0 VAL)))<br />         ((= "Z" kw)(princ "\nOK!"))<br />         ((= "V" kw)(setq nval (/ (* val nvl) (abs val))<br />                          ipt (cdr (assoc 10 ent)) ang (cdr (assoc 50 ent)))<br />                    (COMMAND "UCS" "")             ;MUST LINE<br />                    (setvar "osmode" 0)<br />                    (setq pt1 (polar ipt ang val) anp (/ pi 20)<br />                          pt2 (polar ipt ang nval)<br />                          p1 (polar pt1 (+ (+ ang (/ pi 2)) anp) 200)<br />                          p2 (polar pt1 (+ (- ang (/ pi 2)) anp) 200))) <br />         ((= "S" kw)(setq nval (* sc VAL)))<br />   )     <br />   (setq nent (subst (cons cod nval) oe ent)) (entmod nent) <br />   (if (or (= "V" kw) (= "S" kw))                                     ;y value<br />       (if(/= "C" (cdr (assoc 2 ent)))<br />       (progn  (setq oe (assoc 42 nent) val (cdr oe))<br />         (if(= "V" kw)(setq nval (/ (* val nvl) (abs val))))<br />         (if(= "S" kw)(setq nval (* sc VAL)))<br />         (setq nent (subst (cons 42 nval) oe nent))<br />         (entmod nent)<br />   )   ))<br />   (if (= "V" kw) <br />       (command "_stretch" "c" p1 p2 "" pt1 pt2)  <br /> ) )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;end<br /> (princ "\n   chb---block块修改工具------------------lxx.97.4[2001.2m]")(princ)<br />   [/FONT]<br />

longer1000

这么好的东西，怎么没有人顶

XD12345

谢谢