[LISP程序]：改变图块中的实体－－－工具集

梦断江南

2. 
   
3.   [FONT=courier new]
   
4. ;;;--------------------------------------
   
5. ;;;    变块中实体        ;;;;;;;;;;;;;  lxx v1.02
   
6. ;;;--------------------------------------
   
7. (princ "\n变块中实体v1.02---------lxx.2001.6")
   
8. (defun cbe (cod key / nl)  
   
9.   (while  (not(progn (setq en (nentsel)
   
10.                        ent (car en)
    
11.                        entl (entget ent '("*"))                     
    
12.                      )
    
13.           )   )
    
14.   )
    
15.   (if (setq eb (last (nth 3 en)))
    
16.     (setq ebl (entget eb)))
    
17.   (redraw ent 3)
    
18.   (if (= cod "x")
    
19.     (progn
    
20.       (textscr)
    
21.       (mapcar 'print entl)(princ)
    
22.       (setq cod (getint "\n组码:"))
    
23.     )
    
24.   )
    
25.   (setq ec (cdr (assoc cod entl)))
    
26.   (princ "\n原值:")(princ (assoc cod entl))  
    
27.   (if (= 1 key)
    
28.      (if (not (setq nv (cdr (assoc cod (setq ent2 (entget (car(nentsel "\n选择参照实体:"))))))))
    
29.          (if (= cod 62)(setq nv (cdr (assoc cod (tblsearch "LAYER" (cdr (assoc 8 ent2)) ) ))));;有待完善
    
30.      )  
    
31.      (cond              ;;;;;;else
    
32.       ((= 'STR (type ec))(setq nv (getstring  t "\n字串替换为:")))
    
33.       ((= 'INT (type ec))(setq nv (getint "\nINT值替换为:")))
    
34.       ((= 'REAL (type ec))(setq nv (getreal "\n\nREAL值替换为:")))
    
35.       ((= 'LIST (type ec))
    
36.                 (setq nv (read (strcat "(" (getstring t "\nLIST替换为(点表-->回车取参照点):") ")")));;如 "1.0 3.3 0.0"
    
37.                 (graphscr)
    
38.                 (if (not nv)(setq nv (setq cpt (getpoint "\n点取参照点:"))))
    
39.                 (if eb (setq nv (trans cpt 1 ent)))
    
40.                 )
    
41.       ((not ec) (setq nl (read (getstring t "\n加入新表元(...):"))))
    
42.     )
    
43.   )
    
44.   (if (not nl) (setq nl (cons cod nv)))
    
45.   (princ "\n新值:")(princ nl)
    
46.   (graphscr)
    
47.   (redraw ent 4)
    
48.   (if ec
    
49.     (setq entl (subst nl (assoc cod entl) entl))
    
50.     (setq entl (append entl (list nl)))
    
51.   )
    
52.   (entmod entl)(entupd ent)(if eb (entupd eb))
    
53.   ;(setq cod nil key nil)
    
54. )
    
55. ;;;;;;;;;;;;;;;;;;
    
56. (defun c:xla (/ cod key) (princ "\n改层")(cbe 8 0)(princ))
    
57. (defun c:xla2 (/ cod key) (princ "\n改层k")(cbe 8 1)(princ))
    
58. (defun c:xc (/ cod key) (princ "\n改色")(cbe 62 0)(princ))
    
59. (defun c:xc2 (/ cod key) (princ "\n改色k")(cbe 62 1)(princ))
    
60. (defun c:xlt (/ cod key) (princ "\n改线形")(cbe 6 0)(princ))
    
61. (defun c:xlt2 (/ cod key) (princ "\n改线形k")(cbe 6 1)(princ))
    
62. (defun c:xt (/ cod key) (princ "\n改字串")(cbe 1 0)(princ))
    
63. (defun c:xt2 (/ cod key) (princ "\n改字串")(cbe 1 1)(princ))
    
64. (defun c:xx1 (/ cod key)(princ "\n改实体数据库 :")(cbe "x" 0)(princ))
    
65. (defun c:xx2 (/ cod key)(princ "\n改实体数据库 :")(cbe "x" 1)(princ))
    
66. ;;;;;;;;请自行扩展
    
67.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;;--------------------------------------<br /> ;;;    变块中实体        ;;;;;;;;;;;;;  lxx v1.02<br /> ;;;--------------------------------------<br /> (princ "\n变块中实体v1.02---------lxx.2001.6")<br /> (defun cbe (cod key / nl)  <br />   (while  (not(progn (setq en (nentsel)<br />                        ent (car en)<br />                        entl (entget ent '("*"))                      <br />                      )<br />           )   )<br />   )<br />   (if (setq eb (last (nth 3 en)))<br />     (setq ebl (entget eb)))<br />   (redraw ent 3)<br />   (if (= cod "x")<br />     (progn<br />       (textscr)<br />       (mapcar 'print entl)(princ)<br />       (setq cod (getint "\n组码:"))<br />     )<br />   )<br />   (setq ec (cdr (assoc cod entl)))<br />   (princ "\n原值:")(princ (assoc cod entl))  <br />   (if (= 1 key)<br />      (if (not (setq nv (cdr (assoc cod (setq ent2 (entget (car(nentsel "\n选择参照实体:"))))))))<br />          (if (= cod 62)(setq nv (cdr (assoc cod (tblsearch "LAYER" (cdr (assoc 8 ent2)) ) ))));;有待完善<br />      )  <br />      (cond              ;;;;;;else<br />       ((= 'STR (type ec))(setq nv (getstring  t "\n字串替换为:")))<br />       ((= 'INT (type ec))(setq nv (getint "\nINT值替换为:")))<br />       ((= 'REAL (type ec))(setq nv (getreal "\n\nREAL值替换为:")))<br />       ((= 'LIST (type ec))<br />                 (setq nv (read (strcat "(" (getstring t "\nLIST替换为(点表-->回车取参照点):") ")")));;如 "1.0 3.3 0.0"<br />                 (graphscr)<br />                 (if (not nv)(setq nv (setq cpt (getpoint "\n点取参照点:"))))<br />                 (if eb (setq nv (trans cpt 1 ent)))<br />                 )<br />       ((not ec) (setq nl (read (getstring t "\n加入新表元(...):"))))<br />     )<br />   )<br />   (if (not nl) (setq nl (cons cod nv)))<br />   (princ "\n新值:")(princ nl) <br />   (graphscr)<br />   (redraw ent 4)<br />   (if ec<br />     (setq entl (subst nl (assoc cod entl) entl))<br />     (setq entl (append entl (list nl)))<br />   )<br />   (entmod entl)(entupd ent)(if eb (entupd eb))<br />   ;(setq cod nil key nil)<br /> )<br /> ;;;;;;;;;;;;;;;;;;<br /> (defun c:xla (/ cod key) (princ "\n改层")(cbe 8 0)(princ))<br /> (defun c:xla2 (/ cod key) (princ "\n改层k")(cbe 8 1)(princ))<br /> (defun c:xc (/ cod key) (princ "\n改色")(cbe 62 0)(princ))<br /> (defun c:xc2 (/ cod key) (princ "\n改色k")(cbe 62 1)(princ))<br /> (defun c:xlt (/ cod key) (princ "\n改线形")(cbe 6 0)(princ))<br /> (defun c:xlt2 (/ cod key) (princ "\n改线形k")(cbe 6 1)(princ))<br /> (defun c:xt (/ cod key) (princ "\n改字串")(cbe 1 0)(princ))<br /> (defun c:xt2 (/ cod key) (princ "\n改字串")(cbe 1 1)(princ))<br /> (defun c:xx1 (/ cod key)(princ "\n改实体数据库 :")(cbe "x" 0)(princ))<br /> (defun c:xx2 (/ cod key)(princ "\n改实体数据库 :")(cbe "x" 1)(princ))<br /> ;;;;;;;;请自行扩展<br />   [/FONT]<br />

landscape1111

请列出一个内容祥单