谁能写个修改组码的通用函数，参考代码如下

linshiyin2

谁能写个修改组码的通用函数，要求调用命令为（xgzm  ** （* 123））**为对象名，*为组码123为组码值。
参考代码如下：
(setq ss (ssdel s1 ss)
     s1 (ssname ss 0)
     ent (entget s1)
     txtn (itoa (1+ (atoi txtn)))
     ent (subst
    (cons 1 txtn)
    (assoc 1 ent)
    ent
  )
      )
代码节选自zzxxqq版主的一段

dalin1985

(defun xgzm (name mode)
       (setq endata (entget name))
       (cdr (assoc mode endata))
)

linshiyin2

楼上的还不够好，我的意思是，给出对象，直接修改该对象，的组码，最后重新生成该实体。

linshiyin2

2. ;; 很多函数都是嵌套的，可能部分函数给得不全，就慢慢完善吧……
   
3. ;; xyp-SubUpd 更改图元DXF组码以修改实体属性 (xyp-SubUpd ename code newvalue)
   
4. ;|
   
5. 功能 : 更改图元、图元表、选择集DXF组码以修改实体属性
   
6. 方式 : (xyp-SubUpd 实体名 DXF码 新值)
   
7. 实例1 : 改圆半径为500
   
8. (xyp-SubUpd (car(entsel"\n选择圆: ")) 40 500)
   
9. 实例2 : 改文本为"明经通道"
   
10. (xyp-SubUpd (car(entsel"\n选择文本: ")) 1 "明经通道")
    
11. 实例3 : 改块的插入点为(0 0 0)
    
12. (xyp-SubUpd (car(entsel"\n选择图块: ")) 10 '(0 0 0))
    
13. (xyp-SubUpd (ssget) 62 1)
    
14. |;
    
15. (defun xyp-SubUpd (ename code val / ent x y i s1)
    
16.   (cond ((= (type ename) 'ENAME)
    
17.   (setq ent (entget ename))
    
18.   (if (and (= (type code) 'LIST) (= (type val) 'LIST))
    
19.     (mapcar '(lambda (x y) (xyp-SubUpd ename x y)) code val)
    
20.     (progn
    
21.       (if (= (xyp-get-dxf code ename) nil)
    
22.         (entmod (append ent (list (cons code val))))
    
23.         (entmod (subst (cons code val) (assoc code ent) ent))
    
24.       )
    
25.       (entupd ename)
    
26.     )
    
27.   )
    
28. )
    
29. ((= (type ename) 'PICKSET)
    
30.   (setq i -1)
    
31.   (while (setq s1 (ssname ename (setq i (1+ i))))
    
32.     (xyp-SubUpd s1 code val)
    
33.   )
    
34. )
    
35. ((= (type ename) 'LIST)
    
36.   (foreach s1 ename (xyp-SubUpd s1 code val))
    
37. )
    
38.   )
    
39.   ename
    
40. )

;; 很多函数都是嵌套的，可能部分函数给得不全，就慢慢完善吧……<br /> ;; xyp-SubUpd 更改图元DXF组码以修改实体属性 (xyp-SubUpd ename code newvalue)<br /> ;|<br /> 功能 : 更改图元、图元表、选择集DXF组码以修改实体属性<br /> 方式 : (xyp-SubUpd 实体名 DXF码 新值)<br /> 实例1 : 改圆半径为500<br /> (xyp-SubUpd (car(entsel"\n选择圆: ")) 40 500)<br /> 实例2 : 改文本为"明经通道"<br /> (xyp-SubUpd (car(entsel"\n选择文本: ")) 1 "明经通道")<br /> 实例3 : 改块的插入点为(0 0 0)<br /> (xyp-SubUpd (car(entsel"\n选择图块: ")) 10 '(0 0 0))<br /> (xyp-SubUpd (ssget) 62 1)<br /> |;<br /> (defun xyp-SubUpd (ename code val / ent x y i s1)<br />   (cond ((= (type ename) 'ENAME)<br />   (setq ent (entget ename))<br />   (if (and (= (type code) 'LIST) (= (type val) 'LIST))<br />     (mapcar '(lambda (x y) (xyp-SubUpd ename x y)) code val)<br />     (progn<br />       (if (= (xyp-get-dxf code ename) nil)<br />         (entmod (append ent (list (cons code val))))<br />         (entmod (subst (cons code val) (assoc code ent) ent))<br />       )<br />       (entupd ename)<br />     )<br />   )<br /> )<br /> ((= (type ename) 'PICKSET)<br />   (setq i -1)<br />   (while (setq s1 (ssname ename (setq i (1+ i))))<br />     (xyp-SubUpd s1 code val)<br />   )<br /> )<br /> ((= (type ename) 'LIST)<br />   (foreach s1 ename (xyp-SubUpd s1 code val))<br /> )<br />   )<br />   ename<br /> )

vlisp2012

多谢linshiyin2 。很好的代码！！！

zml84

练习  组码操作.lsp

---

;|问题来源：http://bbs.mjtd.com/thread-96667-1-1.html

谁能写个修改组码的通用函数

要求：调用命令为（xgzm  ** （* 123））
其中：**为对象名，*为组码123为组码值。

|;
;;;=================================================================*
;;;测试： (xgzm (ssget) '(10 0 0 0))                                *
;;;日期：zml84 于 2012-10-20 10:10                                  *
(defun xgzm (ss lst / i en ent)
    (setq i 0)
    (repeat (sslength ss)
	(setq en  (ssname ss i)
	      ent (entget en)
	      ent (subst lst (assoc (car lst) ent) ent)
	)
	(entmod ent)
	(setq i (1+ i))
    )
)
;;;=================================================================*

dingtiedt

zml84 发表于 2012-10-20 10:17
练习 &nbsp;组码操作.lsp
document.write("最后修改时间: " + document.lastModified)

请问，能不能修改，如果有两个或两个以上相同的组码，能批量修改。谢谢!