StevJ 发表于 2022-7-18 10:08:23

协助计划更新

我有一个工作程序,是李在2010年为我整理的。
它最初是为了突出显示某些插入或块引用。
我修改了一个副本以接受用户输入,该输入基于其块定义中的对象类型条目高亮显示属性区域。
标签是OBJTYPE,条目可以是EQ、PP、LDB和许多更多。通常,图形中分散着几个,有时是几十个,这个例程有助于快速定位所有特定对象类型。
我似乎不知道如何修改这个东西,以便如果正在搜索的对象类型在图形中不存在,则在警告框中通知用户。不是打印到命令行,而是一个警报框。
目前,如果一个对象类型不存在,该程序只会退出,而不会出现戏剧效果。
没关系,但我想消除在一些非常大的图形上逐点搜索所造成的延迟,只需告诉用户没有正在搜索的内容。
任何帮助或提示将不胜感激,我上传了一个绘图(2010年格式)与一些地区,如果你的游戏。
谢谢


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Original by LeeMac @ cadtutor.net 16 NOV 2010
;; So long ago the saved link is broken.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mod by SteveJ July 2022 to highlight all of specified OBJ TYPE.

(defun c:OBJ (/ ot ss attLst Box ul lr)
(vl-load-com)

(setq ot (strcase (getstring "Enter OBJ TYPE to locate: ")))

(if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
    (progn
      (command "regen");erases current highlighting for next search.
      (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)))
      (if (and (assoc "OBJTYPE" attLst)
               (eq ot (cdr (assoc "OBJTYPE" attLst)))
               (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)) ;RIGHT
                        1 ul (list (car lr) (cadr ul)) ;TOP
                        1 lr (list (car ul) (cadr lr)) ;BOTTOM
                        1 ul (list (car ul) (cadr lr)) ;LEFT
                                        ))))))
    (princ "\n<!> No Attributed Blocks Found <!>"))
(princ))


;;
;;(alert "No Such Animal")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
页: [1]
查看完整版本: 协助计划更新