zyz398298804 发表于 2022-4-11 17:36:29

求助CAD中setbylayer命令的源码

如题！

wharan 发表于 2022-4-11 18:07:40

(vl-cmdf "CHPROP" "all" "" "C" "ByLayer" "")

zyz398298804 发表于 2022-4-12 09:17:19

wharan 发表于 2022-4-11 18:07
(vl-cmdf "CHPROP" "all" "" "C" "ByLayer" "")

多谢！但是我试了下这个没法对块中块里的内容生效呀 直接用setbylayer，里面有好多个块也能让里面的线随层

alexmai 发表于 2022-4-13 09:42:48

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=184659&highlight=%BF%E9%2B%B8%C4

xiaodehan 发表于 前天 18:00

同求，楼主找到了吗

Sring65 发表于 前天 20:18


;;;==============================================================
;;;                          改变颜色                               
;;;==============================================================

;;;改块内部属性颜色随块
(defun zc_chgblkclr (ss / i ssn BLOCKList)
(setq i -1)
(while (setq ssn (ssname ss (setq i (1+ i))))
    (ZC_chgEntclr ssn)
) ;_repeat
) ;_zc_chgblkclr
(defun ZC_chgEntclr (ent)
(setq        name (vl-catch-all-apply
             'vla-get-name
             (list (vlax-ename->vla-object ent))
             )
)                                        ;获取块名
(if (not (VL-CATCH-ALL-ERROR-P name))
    (if        (and (setq ent (tblobjname "BLOCK" name))
             (not (member ent BLOCKList))
        )
      (progn
        (setq BLOCKList (cons ent BLOCKList))
        (while (setq ent (entnext ent))
          (setq obj (vlax-ename->vla-object ent))
          (if (/= 0 (vla-get-color obj)) ;颜色是否随块
          (vla-put-color obj 0)        ;修改颜色随块
          )
          (ZC_chgEntclr ent)                ;递归判断是否为块
        )
      ) ;_while
    ) ;_if
) ;_if
) ;_ZC_chgEntclr
;;; 修改颜色

(defun zc_chgclr (clr / old_CMDECHO *error* ss)
(defun *error* (msg)
    (setvar "CMDECHO" old_CMDECHO)
    (vla-endundomark acadDoc)
    (if        (not (wcmatch (strcase msg t)
                      "*取消*,*退出*,*break,*cancel*,*exit*"
             )
        )
      (princ (strcat "\n运行错误: " msg))
    )
    (princ)
)
(setq old_CMDECHO (getvar "CMDECHO"))
(setq acadDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-StartUndoMark acadDoc)
(if (not (setq ss (cadr (SSGETFIRST))))
    (while (not (setq ss (ssget))))
)
(setvar "CMDECHO" 0)
(zc_chgblkclr ss)
(command "_change" ss "" "p" "c" clr "") ; 改选集颜色
(setvar "CMDECHO" old_CMDECHO)
(vla-endundomark acadDoc)
(princ)
)

(defun c:1 ()
(zc_chgclr 1)
)
(defun c:2 ()
(zc_chgclr 2)
)
(defun c:3 ()
(zc_chgclr 3)
)
(defun c:4 ()
(zc_chgclr 4)
)
(defun c:5 ()
(zc_chgclr 5)
)
(defun c:6 ()
(zc_chgclr 6)
)
(defun c:7 ()
(zc_chgclr 7)
)
(defun c:8 ()
(zc_chgclr 8)
)
(defun c:9 ()
(zc_chgclr 9)
)
(defun c:0 ()
(zc_chgclr "ByBlock")
)
(defun c:- ()
(zc_chgclr "ByLayer")
)
(princ)
页: [1]
查看完整版本: 求助CAD中setbylayer命令的源码