wei209 发表于 2005-10-29 00:31:00

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

<P>删除实体扩展属性(vb),谁给写个LISP,谢谢!</P>
<P>Public Function XDataErase(ByRef objAcadEntity As AcadEntity) As Boolean<BR>&nbsp;&nbsp;&nbsp; Dim varXdataType&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Variant<BR>&nbsp;&nbsp;&nbsp; Dim varXdataValue&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; As Variant<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; XDataErase = False<BR>&nbsp;&nbsp;&nbsp; Err.Clear<BR>&nbsp;&nbsp;&nbsp; On Error GoTo errhandle<BR>'&nbsp;&nbsp;&nbsp; objAcadEntity.GetXData "", varXdataType, varXdataValue<BR>&nbsp;&nbsp;&nbsp; objAcadEntity.GetXData "", varXdataType, varXdataValue<BR>&nbsp;&nbsp;&nbsp; If Not IsEmpty(varXdataType) Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim Preserve varXdataType(0)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim Preserve varXdataValue(0)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; objAcadEntity.SetXData varXdataType, varXdataValue<BR>&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; XDataErase = True<BR>&nbsp;&nbsp;&nbsp; Exit Function<BR>errhandle:<BR>&nbsp;&nbsp;&nbsp; MsgBox Err.Description<BR>End Function</P>

tanjurun 发表于 2020-5-31 22:44:50

测试下,看看效果好不好

wmz 发表于 2005-10-29 12:40:00

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

wei209 发表于 2005-10-29 22:40:00

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

无痕 发表于 2005-10-30 01:13:00

<P>加油</P>

wmz 发表于 2005-10-30 09:30:00

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


<DIV><FONT style="BACKGROUND-COLOR: #f3f3f3">是不是这个意思?</FONT></DIV>
<DIV><FONT style="BACKGROUND-COLOR: #f3f3f3">;;删除实体所有扩展数据项目<BR>(defun c:Del-xData(/ e s m)<BR>&nbsp;&nbsp;&nbsp;&nbsp; (setq s (ssget "X" '((-3 ("*")))) m -1)<BR>&nbsp; (repeat (sslength s)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq e (ssname s (setq m (1+ m))))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (entmod (list (cons -1 e)(cons -3 (mapcar 'list (mapcar 'car (cdr(assoc -3 (entget e '("*")))))))))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (alert (strcat "这是第" (rtos (+ m 1) 2 0) "个实体,是" (cdr(assoc 0 (entget e))) "实体")) <BR>&nbsp; )&nbsp; <BR>)</FONT><BR></DIV>

wmz 发表于 2005-10-30 09:32:00

无痕发表于2005-10-30 1:13:00static/image/common/back.gif
加油

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

helison 发表于 2005-10-30 09:52:00

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

wei209 发表于 2005-10-30 10:22:00

<P>是这个意思,非常感谢!</P>
<P>无痕老弟是让你给写出来,他不......呵呵!</P>

wei209 发表于 2005-10-30 21:35:00

<P>当图内没有实体带扩展属性时,会出来错误!</P>
<P>一个一个的对话,很费劲!</P>
<P>我加上点,改了一下,感觉效果更好!</P>
<P>;;删除实体所有扩展数据项目<BR>(defun c:<FONT style="BACKGROUND-COLOR: #f3f3f3">Del-xData</FONT>(/ e s m)<BR>&nbsp;&nbsp;&nbsp;&nbsp; (setq s (ssget "X" '((-3 ("*")))) m -1)<BR>&nbsp;&nbsp;&nbsp;&nbsp; (if (/= s nil)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (repeat (sslength s)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq e (ssname s (setq m (1+ m))))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (entmod (list (cons -1 e)(cons -3 (mapcar 'list (mapcar 'car (cdr(assoc -3 (entget e '("*")))))))))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (print (strcat "这是第" (rtos (+ m 1) 2 0) "个实体,是" (cdr(assoc 0 (entget e))) "实体")) <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp; (prin1)<BR>)<BR>再次感谢WMZ</P>

wmz 发表于 2005-10-31 11:00:00

这当然是可以的啦!
页: [1] 2
查看完整版本: 删除实体扩展属性(vb),谁给写个LISP,谢谢!