不久前，李·麦克很友善地为我写了这个工具。这是一个整洁的程序，根据区域的形状，在我创建的某些属性区域周围绘制一个虚线框。他让它很容易修改，我已经——很多次了。作为一个QA工具，它可以节省大量的时间。再次感谢李。
不过，改变是不可避免的，现在我发现还需要根据一个名为RIN的属性标记（以PNG结尾）而不是形状或层来勾勒某些区域的轮廓，如ZX39EX84K43。巴布亚新几内亚。
它不想玩。只是坐在那里什么也不做（像我妻子的猫）。
为了便于查找，相关的线是红色的。如果你们当中有人能看一眼，告诉我我做错了什么，也许能把我踢向正确的方向，我会非常感谢你们的帮助。
谢谢
史蒂夫
- ;;;
- ;;; Crafted by Lee Mac at cadtutor.net 14 May 2009
- ;;; http://www.cadtutor.net/forum/showthread.php?36206/page2
- ;;; Modifications by Steve J:
- ;;; 14 May 2009 - To use dashed red vector lines
- ;;; Wish list 14 Nov 2010:
- ;;; To be able to select with wildcard when
- ;;; attribute tag RIN ends with PNG.
- ;;; Why "*PNG" no workee?
- (defun c:ZQA (/ ss attLst Box ul lr)
- (vl-load-com)
- (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
- (progn
- (foreach Obj (mapcar 'vlax-ename->vla-object
- (mapcar 'cadr (ssnamex ss)))
- (setq attLst nil)
- (foreach att (vlax-safearray->list
- (vlax-variant-value
- (vla-getAttributes Obj)))
- (setq attLst (cons (cons (vla-get-TagString att)
- (vla-get-TextString att)) attLst)))
- [color=red] (if (and (assoc "RIN" attLst)
- (eq "*PNG" (cdr (assoc "RIN" attLst)))[/color]
- (setq Box (assoc "BOXSIZE" attLst)
- Box (read (cdr Box))))
- (progn
- (setq ul (list (car Box) (cadr Box))
- lr (list (caddr Box) (cadddr Box)))
- (grvecs (list -1 lr (list (car lr) (cadr ul))
- -1 ul (list (car lr) (cadr ul))
- -1 lr (list (car ul) (cadr lr))
- -1 ul (list (car ul) (cadr lr))))))))
- (princ "\n<!> No Attributed Blocks Found <!>"))
- (princ)
- )
| 
置顶卡
