caiqs 发表于 2006-5-22 18:33:00

Vlisp超级取属性函数

<P>;;;cqs&nbsp; &nbsp;蔡全胜&nbsp; 2006/5/20</P>
<P><BR>;;;看 大 家 都 贴,&nbsp;&nbsp; 我 也 贴 一 个&nbsp; ,希望 版 主 加 分</P>
<P>;;;CAD二次开发交流群 3014229 &nbsp;欢迎高手加入</P>
<P><BR>;;;超级取属性值函数<BR>;;;(test 表 lisp对象)<BR>;;;例 (setq obj(vlax-ename-&gt;VLA-object(car(entsel))))<BR>;;;(test (list '(C Center) '(R Radius) '(L Layer) '(CL Color)) obj)<BR>;;;当对象不支持属性时会在命令行报告<BR>;;;返回值：关联表 ((c . 值)(R . 值)(L . 值))<BR>(defun test (ptylst VLAobj / ptyval pty tempconslst ruturnconslst)<BR>&nbsp; (foreach ptyval ptylst<BR>&nbsp;&nbsp;&nbsp; (setq pty (read (vl-symbol-name (cadr ptyval))))<BR>&nbsp;&nbsp;&nbsp; (if&nbsp;(vlax-property-available-p VLAobj pty)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<BR>&nbsp;(set (car ptyval) (vlax-get-property VLAobj pty))<BR>&nbsp;(setq tempconslst<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cons (car ptyval) (vl-symbol-value (car ptyval)))<BR>&nbsp;)<BR>&nbsp;(setq ruturnconslst(cons tempconslst ruturnconslst))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (princ (strcat "\n不支持属性：" (vl-symbol-name pty)))<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp; )<BR>&nbsp; ruturnconslst<BR>)</P>

caiqs 发表于 2006-7-3 12:09:00

<P>;;;应版主要求,改了一下</P>
<P>&nbsp;</P>
<P>;;;cqs&nbsp; &nbsp;蔡全胜&nbsp; 2006/7/2</P>
<P><BR>;;;看 大 家 都 贴,&nbsp;&nbsp; 我 也 贴 一 个&nbsp; ,希望 版 主 加 分</P>
<P>;;;CAD二次开发交流群 3014229 &nbsp;欢迎高手加入</P>
<P>;;;超级图元属性值批量提取函数<BR>;;;(getproperty 表 VLA对象)<BR>;;;(setq obj(vlax-ename-&gt;VLA-object(car(entsel))))<BR>;;;例1: (getproperty '((C Center)(R Radius)(L Layer)(CL Color)) obj)<BR>;;; 例2:(getproperty '((0 Center) (1 Radius) (2 Layer) (3 Color)) obj)<BR>;;;返回值：提取的关联表<BR>(defun getproperty<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (ptylst VLAobj / ptyval pty tempconslst ruturnconslst)<BR>&nbsp; (vl-load-com)<BR>&nbsp; (cond<BR>&nbsp;&nbsp;&nbsp; ((and ptylst vlaobj)<BR>&nbsp;&nbsp;&nbsp;&nbsp; (foreach ptyval ptylst<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq pty (cadr ptyval))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (vlax-property-available-p VLAobj pty)<BR>&nbsp; (progn<BR>&nbsp;&nbsp;&nbsp; (setq tempconslst<BR>&nbsp;&nbsp;&nbsp; (cons (car ptyval) (vlax-get-property VLAobj pty))<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp; (setq ruturnconslst (cons tempconslst ruturnconslst))<BR>&nbsp; )<BR>&nbsp; (princ (strcat "\n对象不支持的属性："&nbsp; (vl-symbol-name pty) "\n"))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp;&nbsp; ruturnconslst<BR>&nbsp;&nbsp;&nbsp; )<BR>;;;下边这几行模似C++的编程思想,在出错时报告函数内的信息<BR>&nbsp;&nbsp;&nbsp; (t<BR>&nbsp;&nbsp;&nbsp;&nbsp; (princ "\n函数 getproperty 中出现异外!")<BR>&nbsp;&nbsp;&nbsp;&nbsp; (princ (list ptylst VLAobj))<BR>&nbsp;&nbsp;&nbsp;&nbsp; nil<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp; )<BR>)</P>
页: [1]
查看完整版本: Vlisp超级取属性函数