不用command语句该如何表达 - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第2页

tryhi 发表于 2020-8-10 09:55:21

magicheno 发表于 2020-8-9 01:13
(defun c:TT5() (try-Layer-off '("WP_G""WP_G_DN")))
(defun try-Layer-off (layList))
(se ...
复制都复制错

(setq
;;常用VLA对象、集合
*ACAD*(vlax-get-acad-object)
*DOC* (vla-get-ActiveDocument *ACAD*)
*DOCS*(vla-get-Documents *ACAD*)
*MS* (vla-get-modelSpace *DOC*)
*PS* (vla-get-paperSpace *DOC*)
*BLKS*(vla-get-Blocks *DOC*)
*LAYS*(vla-get-Layers *DOC*)
*LTS* (vla-get-Linetypes *DOC*)
*STS* (vla-get-TextStyles *DOC*)
*GRPS*(vla-get-groups *DOC*)
*DIMS*(vla-get-DimStyles *DOC*)
*LOUTS* (vla-get-Layouts *DOC*)
*VPS* (vla-get-Viewports *DOC*)
*VS* (vla-get-Views *DOC*)
*DICS*(vla-get-Dictionaries *DOC*)
*Layouts* (vla-get-Layouts *doc*)
)
(defun try-Layer-Off (LayList)
(setq LayList(mapcar 'strcase LayList))
(vlax-for each *LAYS*
(if (member (strcase (vla-get-name each)) LayList)
(if (vlax-write-enabled-p each)
(vla-put-LayerOn each :vlax-False)
)
)
(vlax-release-object each)
)
)
(defun c:tt5 ()
(try-Layer-off '("WP_G""WP_G_DN"))
)

magicheno 发表于 2020-8-10 11:33:20

tryhi 发表于 2020-8-10 09:55
复制都复制错

(setq

感谢大侠原来如此，没把集合放进去，这种不能用*通用符号的，是不是只能一个一个输入图层的，图层是比较多的都是类似的，某一类的图层，比如WP_G_DN,WP_G_EV,WP_G_PJ,WP_G_NOTE,WP_G_LG,WP_G_TXT,等等图层的

tryhi 发表于 2020-8-10 15:34:43

magicheno 发表于 2020-8-10 11:33
感谢大侠原来如此，没把集合放进去，这种不能用*通用符号的，是不是只能一个一个输入图层的，图层 ...

(try-Layer-Off(vl-remove-if-not '(lambda(x)(wcmatch x "WP_G*"))(try-Layer-allname)))

magicheno 发表于 2020-8-10 16:53:43

tryhi 发表于 2020-8-10 15:34
(try-Layer-Off(vl-remove-if-not '(lambda(x)(wcmatch x "WP_G*"))(try-Layer-allname)))

感谢大侠，原来如此，懂了一点点，这样子就可以实现我发的command那样的效果了，其他类似不同的图层的也只需要增加 try-Layer-Offtry-Layer-on命令就可以了
(setq
   ;;常用VLA对象、集合
   *ACAD*(vlax-get-acad-object)
   *DOC* (vla-get-ActiveDocument *ACAD*)
   *DOCS*(vla-get-Documents *ACAD*)
   *MS* (vla-get-modelSpace *DOC*)
   *PS* (vla-get-paperSpace *DOC*)
   *BLKS*(vla-get-Blocks *DOC*)
   *LAYS*(vla-get-Layers *DOC*)
   *LTS* (vla-get-Linetypes *DOC*)
   *STS* (vla-get-TextStyles *DOC*)
   *GRPS*(vla-get-groups *DOC*)
   *DIMS*(vla-get-DimStyles *DOC*)
   *LOUTS* (vla-get-Layouts *DOC*)
   *VPS* (vla-get-Viewports *DOC*)
   *VS* (vla-get-Views *DOC*)
   *DICS*(vla-get-Dictionaries *DOC*)
   *Layouts* (vla-get-Layouts *doc*)
)

;;返回所有图层的名称(字符串表)
(defun try-Layer-allname(/ out)
   (vlax-for obj *LAYS*
            (setq out (cons (vlax-get-property obj 'Name) out))
   )
   (reverse out)
)

(defun try-Layer-Off (LayList)
   (setq LayList(mapcar 'strcase LayList))
   (vlax-for each *LAYS*
            (if (member (strcase (vla-get-name each)) LayList)
                     (if (vlax-write-enabled-p each)
                           (vla-put-LayerOn each :vlax-False)
                     )
            )
            (vlax-release-object each)
   )
)

;;打开关闭图层
;;参数：图层名称表
(defun try-Layer-On (LayList)
   (setq LayList(mapcar 'strcase LayList))
   (vlax-for each *LAYS*
            (if (member (strcase (vla-get-name each)) LayList)
                     (if (vlax-write-enabled-p each)
                           (vla-put-LayerOn each :vlax-True)
                     )
            )
            (vlax-release-object each)
   )
)

(defun c:tt5 ()
   (try-Layer-Off(vl-remove-if-not '(lambda(x)(wcmatch x "*"))(try-Layer-allname)))
   (try-Layer-on(vl-remove-if-not '(lambda(x)(wcmatch x "WP_G*"))(try-Layer-allname)))
)

(defun c:tt6 ()
   (try-Layer-on(vl-remove-if-not '(lambda(x)(wcmatch x "WP_G*"))(try-Layer-allname)))
)

(defun c:tt7 ()
   (try-Layer-Off(vl-remove-if-not '(lambda(x)(wcmatch x "WP_G*"))(try-Layer-allname)))
)

tryhi 发表于 2020-8-10 17:36:55

magicheno 发表于 2020-8-10 16:53
感谢大侠，原来如此，懂了一点点，这样子就可以实现我发的command那样的效果了，其他类似不同的图层的也 ...

;;打开关闭图层
;;参数：字符串，支持通配符
(defun try-Layer-on-2 (layer)
(try-Layer-on(vl-remove-if-not '(lambda(x)(wcmatch x layer))(try-Layer-allname)))
)

;;打开关闭图层
;;参数：字符串，支持通配符
(defun try-Layer-off-2 (layer)
(try-Layer-off(vl-remove-if-not '(lambda(x)(wcmatch x layer))(try-Layer-allname)))
)

(try-Layer-on-2 "WP_G*");打开P_G开头的图层
(try-Layer-on-2 "WP_G_DN,WP_G_EV,WP_G_PJ,WP_G_NOTE,WP_G_LG,WP_G_TXT");打开WP_G_DN,WP_G_EV,WP_G_PJ,WP_G_NOTE,WP_G_LG,WP_G_TXT这6个图层

关闭图层不做举例

magicheno 发表于 2020-8-10 17:57:14

tryhi 发表于 2020-8-10 17:36
;;打开关闭图层
;;参数：字符串，支持通配符
(defun try-Layer-on-2 (layer)

感谢大侠，相当于设定了指定函数，后面只要加开关就行了，更简化了

magicheno 发表于 2020-8-10 21:05:24

本帖最后由 magicheno 于 2020-8-11 01:14 编辑

tryhi 发表于 2020-8-10 17:36
;;打开关闭图层
;;参数：字符串，支持通配符
(defun try-Layer-on-2 (layer)

大侠按照新的要求改了下，运行不了，不知道是哪里的问题呢
(setq
   ;;常用VLA对象、集合
   *ACAD*(vlax-get-acad-object)
   *DOC* (vla-get-ActiveDocument *ACAD*)
   *DOCS*(vla-get-Documents *ACAD*)
   *MS* (vla-get-modelSpace *DOC*)
   *PS* (vla-get-paperSpace *DOC*)
   *BLKS*(vla-get-Blocks *DOC*)
   *LAYS*(vla-get-Layers *DOC*)
   *LTS* (vla-get-Linetypes *DOC*)
   *STS* (vla-get-TextStyles *DOC*)
   *GRPS*(vla-get-groups *DOC*)
   *DIMS*(vla-get-DimStyles *DOC*)
   *LOUTS* (vla-get-Layouts *DOC*)
   *VPS* (vla-get-Viewports *DOC*)
   *VS* (vla-get-Views *DOC*)
   *DICS*(vla-get-Dictionaries *DOC*)
   *Layouts* (vla-get-Layouts *doc*)

)

;;返回所有图层的名称(字符串表)
(defun try-Layer-allname(/ out)
   (vlax-for obj *LAYS*
            (setq out (cons (vlax-get-property obj 'Name) out))
   )
   (reverse out)
)

;打开图层
;;参数：图层名称表
(defun try-Layer-On (LayList)
   (setq LayList(mapcar 'strcase LayList))
   (vlax-for each *LAYS*
            (if (member (strcase (vla-get-name each)) LayList)
                     (if (vlax-write-enabled-p each)
                           (vla-put-LayerOn each :vlax-True)
                     )
            )
            (vlax-release-object each)
   )
)

;;关闭图层
;;参数：图层名称表
(defun try-Layer-Off (LayList)
   (setq LayList(mapcar 'strcase LayList))
   (vlax-for each *LAYS*
            (if (member (strcase (vla-get-name each)) LayList)
                     (if (vlax-write-enabled-p each)
                           (vla-put-LayerOn each :vlax-False)
                     )
            )
            (vlax-release-object each)
   )
)

;;打开关闭图层
;;参数：字符串，支持通配符
(defun try-Layer-on-2 (layer)
      (try-Layer-on(vl-remove-if-not '(lambda(x)(wcmatch x layer))(try-Layer-allname)))
)

;;打开关闭图层
;;参数：字符串，支持通配符
(defun try-Layer-off-2 (layer)
      (try-Layer-off(vl-remove-if-not '(lambda(x)(wcmatch x layer))(try-Layer-allname)))
)

;;;打开给水图层
(defun c:tt5 ()
   (try-Layer-off-2 "*")
   (try-Layer-on-2 "WP_G,DN_G,LGBH_G,TXT_G,EV_G,WP_G_*")
)

;;;关闭给水图层
(defun c:tt7 ()
   (try-Layer-off-2 "WP_G,DN_G,LGBH_G,TXT_G,EV_G,WP_G_*")
)
;;;可开给水层
(defun c:tt6 ()
   (try-Layer-on-2 "WP_G,DN_G,LGBH_G,TXT_G,EV_G,WP_G_*")
)

;; 关其他水层仅显示给水层
(defun c:tt8 ()
   (try-Layer-off-2 "WP_*,DN_*,LGBH_*,TXT_*,EV_*,W-DIM,W_DIM,WW_*,WX-*,SB,SB_*,PUB_W-DIM,PUB_TABLE,PUB_W-DIM")
   (try-Layer-on-2 "WP_G,DN_G,LGBH_G,TXT_G,EV_G,WP_G_*")
)

tryhi 发表于 2020-8-10 23:32:35

本帖最后由 tryhi 于 2020-8-10 23:34 编辑

magicheno 发表于 2020-8-10 21:05
大侠按照新的要求改了下，运行不了，不知道是哪里的问题呢
(setq
;;常用VLA对象、集合
...
一对全角括号，怀疑你平时程序怎么写出来的

magicheno 发表于 2020-8-11 01:12:22

本帖最后由 magicheno 于 2020-8-11 01:21 编辑

tryhi 发表于 2020-8-10 23:32
一对全角括号，怀疑你平时程序怎么写出来的
一直都没注意这个，只会一点皮毛，没怎么真正写过程序，之前修修改改一些command，没怎么出现这种问题的，我就纳闷了，原来打括号的时候打成中文括号了，尴尬了，感谢大侠指教的按你的函数这样写，比之前command简化太多了，我要把之前用command设定的命令全部简化一遍的，行数可以少太多了

页: 1 [2]

明经CAD社区's Archiver