KEwb 发表于 2024-11-3 13:19:52

将图中图块内的标注尺寸上的文字颜色改为随层

本帖最后由 KEwb 于 2024-11-3 13:29 编辑

如何图中所有图块内的标注尺寸上的文字颜色改为随层的颜色，并且立刻显示按随层颜色显示

ssyfeng 发表于 2024-11-4 12:16:16

这个要遍历判断处理

凋零叶 发表于 2024-11-6 09:52:07

进入到第一层块,编辑块 把标注都放到 0 图层 设置颜色跟随图层 .或者把所有块都解散 然后遍历 放到0图层.

lgh930 发表于 2024-11-24 17:29:27

针对样例文件的处理
(setq set1 (ssget))(setq list2 nil)
(foreach i (set-list set1)
   
    (progn
    (if(vl-catch-all-error-p(vl-catch-all-apply 'vla-put-color (list (vlax-ename->vla-object (tblobjname "layer"(cdr(assoc 8 (entget i))))) 7)))nil)
    (if(vl-catch-all-error-p(vl-catch-all-apply 'vla-put-color (list (vlax-ename->vla-object i) 7)))nil)
    (if(= "DIMENSION"(cdr(assoc 0 (entget i))))(progn(vla-put-DimensionLineColor(vlax-ename->vla-object i) 0)
                                               (vla-put-ExtensionLineColor(vlax-ename->vla-object i) 0)
                                               (vla-put-TextColor(vlax-ename->vla-object i) 0)))
    (if(= "INSERT" (cdr(assoc 0 (entget i))))
      (progn
        (setq list1 (getblocklist (cdr(assoc 2 (entget i)))))
        (foreach i1 list1
          (foreach i2 (cdr i1)
          (if(vl-catch-all-error-p(vl-catch-all-apply 'vla-put-color (list (vlax-ename->vla-object (tblobjname "layer"(cdr(assoc 8 (entget i2))))) 7)))nil)
          (if(vl-catch-all-error-p(vl-catch-all-apply 'vla-put-color (list (vlax-ename->vla-object i2) 7)))nil)
    (if(= "DIMENSION"(cdr(assoc 0 (entget i2))))
      (progn
        (if(and(member (vla-get-TextColor(vlax-ename->vla-object i2))(list 256 0 7))
             (member (vla-get-DimensionLineColor(vlax-ename->vla-object i2))(list 256 0 7))
             (member (vla-get-ExtensionLineColor(vlax-ename->vla-object i2))(list 256 0 7)))nil
          (progn(if(member (car i1) list2)nil(setq list2 (cons (car i1) list2)))))
        )
      )
          )
        )
      )
    )
    )
)

lgh930 发表于 2024-11-24 17:46:33

(defun getblocks(blkna / d)
(defun getblocks0(sone1)
   (while(and sone1 (/= "ENDBLK" (cdr(assoc 0 (entget sone1)))))
      (if(isblock sone1)(progn(if(member (cdr(assoc 2 (entget sone1))) d)nil(setq d (cons (cdr(assoc 2 (entget sone1))) d)))
                          (getblocks0 (cdr(assoc -2 (tblsearch "block" (cdr(assoc 2 (entget sone1)))))))
                          )
        )
      (setq sone1 (entnext sone1))
    )
)
(getblocks0 (cdr(assoc -2 (tblsearch "block" blkna))))
(cons blkna (reverse d))
)
(defun getblockdefs(blkna / d)
(defun getblockdefs0(sone1)
   (while(and sone1 (/= "ENDBLK" (cdr(assoc 0 (entget sone1)))))
      (if(isblock sone1)(getblockdefs0 (cdr(assoc -2 (tblsearch "block" (cdr(assoc 2 (entget sone1)))))))
        (if(member sone1 d)nil(setq d (cons sone1 d))))
      (setq sone1 (entnext sone1))
    )
)
(getblockdefs0 (cdr(assoc -2 (tblsearch "block" blkna))))
(reverse d)
)

(defun getblocklist(blkna / d)
(setq zlist1 (getblocks blkna))(foreach i zlist1 (setq d (cons(cons i (getblockdefs i)) d)))(reverse d)
)

lgh930 发表于 2024-11-24 20:17:38

(defun set-list(zzset / zzi zzlist1 zze1)
(setq zzi -1 zzlist1 nil)
(if zzset
    (while(setq zze1 (ssname zzset (setq zzi (1+ zzi))))(setq zzlist1 (cons zze1 zzlist1)))
)
zzlist1
)

黄翔 发表于 2024-12-27 11:34:07

本帖最后由 黄翔 于 2024-12-27 11:36 编辑

谢谢分享,缺少一个函数.
(defun isblock(sone1)
   (= "INSERT" (cdr(assoc 0 (entget sone1))))
)
页: [1]
查看完整版本: 将图中图块内的标注尺寸上的文字颜色改为随层