删除实体扩展属性(vb),谁给写个LISP,谢谢!

652758365

;           将所有对象的编码、属性清空
(defun gtdj-bmqk (/ j-g1 k-g1 sm-g1 dx-g1 ty-g1)
   (setq j-g1 (ssget "x"))
  (if j-g1
    (progn
   (setq k-g1 0 sm-g1 (sslength j-g1))
  (while (< k-g1 sm-g1)
       (setq dx-g1 (ssname j-g1 k-g1))
       (setq ty-g1 (entget dx-g1'("*")))
    (if (assoc -3 ty-g1)
      (progn
        (entmake (vl-remove (assoc -3 ty-g1) ty-g1))
        (entdel dx-g1)      ))
    (setq k-g1 (+ k-g1 1))    )     ))
  (setq j-g1 nil)
  (princ)
)


有没有不用entmod的方法

tanjurun

测试下，看看效果好不好