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

wei209

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

Public Function XDataErase(ByRef objAcadEntity As AcadEntity) As Boolean
    Dim varXdataType        As Variant
    Dim varXdataValue       As Variant
   
    XDataErase = False
    Err.Clear
    On Error GoTo errhandle
'    objAcadEntity.GetXData "", varXdataType, varXdataValue
    objAcadEntity.GetXData "", varXdataType, varXdataValue
    If Not IsEmpty(varXdataType) Then
        ReDim Preserve varXdataType(0)
        ReDim Preserve varXdataValue(0)
        objAcadEntity.SetXData varXdataType, varXdataValue
    End If
    XDataErase = True
    Exit Function
errhandle:
    MsgBox Err.Description
End Function

tanjurun

测试下，看看效果好不好

wmz

;;删除实体所有扩展数据项目(转贴自XDCAD)
(defun c:Del-xData(/ e)
  (setq e (car (entsel "\n选择实体: ")))
  (entmod (list (cons -1 e)(cons -3 (mapcar 'list (mapcar 'car (cdr(assoc -3 (entget e '("*")))))))))
)

wei209

谢谢,能完善一下吗?比如说:1,可以全选.2,处理到第几个实体了!

无痕

加油

wmz

wei209发表于2005-10-29 22:40:00谢谢,能完善一下吗?比如说:1,可以全选.2,处理到第几个实体了!

是不是这个意思?

;;删除实体所有扩展数据项目
(defun c:Del-xData(/ e s m)
     (setq s (ssget "X" '((-3 ("*")))) m -1)
  (repeat (sslength s)
       (setq e (ssname s (setq m (1+ m))))
       (entmod (list (cons -1 e)(cons -3 (mapcar 'list (mapcar 'car (cdr(assoc -3 (entget e '("*")))))))))
       (alert (strcat "这是第" (rtos (+ m 1) 2 0) "个实体,是" (cdr(assoc 0 (entget e))) "实体"))
  ) 
)

wmz

无痕发表于2005-10-30 1:13:00 加油

无痕老弟:这"加油"是什么意思?

helison

2楼！！非常感谢！这也正是我想要的东西！呵~

wei209

是这个意思,非常感谢!

无痕老弟是让你给写出来,他不......呵呵!

wei209

当图内没有实体带扩展属性时,会出来错误!

一个一个的对话,很费劲!

我加上点,改了一下,感觉效果更好!

;;删除实体所有扩展数据项目
(defun c:Del-xData(/ e s m)
     (setq s (ssget "X" '((-3 ("*")))) m -1)
     (if (/= s nil)
       (progn
       (repeat (sslength s)
       (setq e (ssname s (setq m (1+ m))))
       (entmod (list (cons -1 e)(cons -3 (mapcar 'list (mapcar 'car (cdr(assoc -3 (entget e '("*")))))))))
       (print (strcat "这是第" (rtos (+ m 1) 2 0) "个实体,是" (cdr(assoc 0 (entget e))) "实体"))
       )
      )
      )
  (prin1)
)
再次感谢WMZ

wmz

这当然是可以的啦！