自动更改颜色对象

The Courage Dog · 发表于 2022-7-6 12:15:57

你好通过将所有对象（即文本、尺寸、图案填充、图纸文件中除标题栏及其标题栏属性外的所有外部参照）的颜色内容更改为灰色，使其看起来像背景色，我正在处理数百个图形。我面临的问题是，一些图层对象的对象颜色不是“bylayer”。有没有人有lisp例程可以运行&自动更改您选择的所有对象的所有颜色？

非常感谢您的回复。

eldon · 发表于 2022-7-6 12:24:26

当你在等待一个好的灵魂为你写一个lisp时，你可以用键盘手动操作：-

命令：-ch（回车）
更改
选择对象：全部（Enter）
找到2254个
378人不在当前空间。

选择对象：（输入）
指定更改点或[特性]：p（输入）

输入要更改的特性[Color/Elev/LAyer/LType/ltScale/LWeight/Thickness]：c（输入）

输入新颜色：bylayer（Enter）

输入要更改的特性[Color/Elev/LAyer/LType/ltScale/LWeight/Thickness]：（输入）
这不适用于嵌入块中的任何行，您必须分解这些行，但它可以在您等待时为您提供一些操作。

alanjt · 发表于 2022-7-6 12:30:22

像这样的？

copy

(defun c:ToColor (/ #SS #Color #Layers #Layer #List)
 (vl-load-com)
 (cond
   ((and (setq #Color (acad_colordlg 1))
         (setq #SS (ssget))
    ) ;_ and
    (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    (setq #Layers (vla-get-layers *AcadDoc*))
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (vl-catch-all-apply 'vla-put-color (list x 256))
      (or (vl-position (setq #Layer (vla-get-layer x)) #List)
          (progn (vla-put-color (vla-item #Layers #Layer) #Color)
                 (setq #List (cons #Layer #List))
          ) ;_ progn
      ) ;_ or
    ) ;_ vlax-for
    (vl-catch-all-apply 'vla-delete (list #SS))
   )
 ) ;_ cond
 (princ)
) ;_ defun

lpseifert · 发表于 2022-7-6 12:37:55

http://www.cadtutor.net/forum/showthread.php?t=31017

VVA · 发表于 2022-7-6 12:45:44

所有层和块的Lisp颜色变化

fixo · 发表于 2022-7-6 12:55:16

外部参照

~'J'~

VVA · 发表于 2022-7-6 13:01:38

ColorX-更改图形所有对象的颜色。所有层解锁和解冻
颜色外部参照仅在当前会话中更改颜色外部参照。所有层解锁和解冻
ColorXL-更改图形所有对象的颜色。锁定层和冻结层上的对象将被忽略
颜色外部参照仅在当前会话中更改颜色外部参照。锁定层和冻结层上的对象将被忽略

COLORXLAY-更改外部参照层的颜色

fixo · 发表于 2022-7-6 13:06:56

И от меня спасибо
Успехов

~'J'~

baijumon · 发表于 2022-7-6 13:13:45

海菲佐
你修改过这个代码吗

代码：
（defun div错误（msg）
（如果
（vl位置
味精
“（“控制台中断”
“功能已取消”
“退出/退出中止”
)
)
（princ“Error！”）
（普林斯消息）
)
（while（>（getvar“cmdactive”）0）（命令））
;;;  （命令“.u undo”“\u end”）
;;;  （命令“_”）
（setq*错误*旧错误）
（普林斯）
)
（defun divplus（len segm/num lst）
（setq num（fix（/len segm）））
（setq cnt 0）
（虽然(
（setq tmp（*cnt segm））
（setq lst（append lst（list tmp）））
（setq cnt（1+cnt））
)
（setq delta（-len（最后一个lst）））
（if（not（zerop delta））
（setq lst（追加lst（列表（+（最后一个lst）增量）））
lst公司
)
)
（defun divminus（len segm/lst）
（而（>=长度0。）
（setq lst（append lst（list len）））
（setq len（-len segm））
)
（if（not（zerop（last lst）））
（setq lst（追加lst（列表0.0）））
)
lst公司
)
（defun alg ang（obj pnt）
（角度'（0.0.0。）
（vlax曲线getfirstderiv
obj公司
（vlax曲线getparamatpoint
obj公司
pnt公司
)
)
)
)
（defun答案（quest/wshl-ans）
（或（vl load com））
（setq wshl（vlax获取或创建对象“WScript.Shell”））
（setq ans（vlax调用方法
wshl公司
“弹出任务7”回答这个问题：“vlax vbYesNo”）
（vlax释放对象wshl）
（条件（=ans 6）
（setq opt）
（=ans 7）
（setq opt nil）
)
选择
)

（defun make station（bname/acsp adoc atprom attag at_obj
blk_obj hgt lay line_obj sfar）
（vl load com）
（setq adoc（vla get activedocument
（vlax get acad对象）
)
)
（如果（和
（=（getvar“tilemode”）0）
（=（getvar“cvport”）1）
)
（setq acsp（vla get paperspace adoc））
（setq acsp（vla get modelspace adoc））
)
（vla startundomark adoc）
（如果（不是（tblsearch“block”bname））
（程序
（setq attag“NUMBER”；（strcase（getstring“\n属性标记：\n”））
atprom“编号”；（strcase（getstring T“\n属性提示：\n”））
hgt 1.0；（getreal“\n属性文本高度：\ n”）
)
（setq lay（getvar“clayer”））
（setvar“clayer”“0”）
（setvar“attreq”0）
（setq line_obj（vlax调用acsp“Addline”（0.0.0。）（列表0。（*hgt 12。）0.)))
（vla put color line_obj acyellow）
（setq blk_obj（vla add（vla get blocks adoc）（vlax-3d-point’（0.0.0））bname）
sfar（vlax安全阵列填充
（vlax make safearray vlax vbObject’（0.0））
（列表行_obj）
)
)
（vla copyobjects adoc sfar blk_obj）
;;;  RetVal=对象。AddAttribute（高度、模式、提示、插入点、标记、值）
（setq at_obj（vla addattribute blk_obj
hgt公司
acattributemodeverify公司
atprom公司
（vlax-3d-点'（-0.5 1.0）
阿塔格
"0+00")
)
;;;  （vla将对齐放在_obj acAlignmentBottomCenter）
;;;  （vla put textalignmentpoint
;;; at_obj
;;; （vlax-3d-point’（0.1.0）
;;;  )
（vla将旋转放置在_obj（/pi 2））
（vlax释放对象blk_obj）
)
（程序
（princ“\n\t>>块已存在！\n”）
（普林斯）
（如果（tblsearch“block”bname）
T
（程序
（警报“无法添加块”））
（setvar“attreq”1）
（setvar“clayer”铺层）
（vl catch all apply（函数（lambda（）（vla delete line_obj）））
（vla regen adoc acactiveviewport）
（vla endundomark adoc）
（vlax释放对象acsp）
（vlax释放对象adoc）
（普林斯）
)
（或（vl load com））
（默认C:d10（/*错误*acsp adoc appd div错误）
len num olderror pl pt\u list
步骤util
)
（或adoc）
（setq adoc
（vla获取activedocument
（vlax get acad对象）
)
)
)
（或appd（setq appd（vla get application adoc）））
（或acsp
（setq acsp
（vla get block）
（vla get activelayout adoc）
)
)
)
（或util（setq util（vla get utility adoc）））
;;;  （命令“.u undo”“\u end”）
;;;  （命令“.u undo”“\u mark”）
（setq olderror*error*）
（setq*error*div error）
;;;  （setq bname（getstring T“\n站块名：\ n”））
;;;  （使站点bname）
（如果（不是（tblsearch“block”“Station”））
（将车站设为“车站”）

（vla getentity）
util
'pl
'点
“\n选择要开始测量的点附近的线：>>\n”
)
（如果pl
（程序
（setq步骤（getreal“\n用于定位的输入步骤：\ n”））
（setq opt（回答“垂直于pline旋转文本？”）
（如果（非步骤）（setq步骤10）

（setq len（vlax曲线getdistatparam
pl
（vlax曲线getendparam pl）
)
)
（如果（列出pt）
（vlax曲线getstartpoint pl）
)
（距离（vlax safearray->列表点）
（vlax曲线getendpoint pl）
)
)
（setq pt_list（divplus len step））
（setq pt_列表（div减去len步长））
)
（setq）
pt\U列表（vl删除if
（功能不）
（mapcar（功能（λ（x））
（vlax曲线getpointatdist pl x）
)
)
pt_列表
)
)
)
（setq num 0）
;;;    （setq num（getint“\n输入初始站号”）
（地图车
（功能
（λ（blk_obj的x/dr ang att_列表）
（程序
（setq ang（alg ang pl x）
ang公司
（条件((
（唐）
)
)
（setq blk_obj（vlax调用
acsp插入块x“Station”1 ang）
)
（setq att_列表（vlax invoke blk_obj’Getattributes））
（foreach at att_列表
（if（eq（vlax get at'Tagstring）“NUMBER”）
（程序
（vlax放在“Textstring”（如果(
（strcat“sta:0+”（rtos num 2）
（strcat“sta：”
（itoa（固定（/1200.1000））
"+"
（rtos（-num（*（fix（/num 1000））1000)) 2 2)
)
))
（如果（非opt）
（vlax置于“旋转0”）
（vla更新于）
)
)
)
（vla更新blk_obj）
（vlax释放对象blk_obj）
（setq num（+num step））
)
)
)
pt_列表
)
（if（not（vlax-object-released-p pl））
（vlax释放对象pl）
)
)
（princ“\n未选择任何内容，请重试”）
)
（vla zoomextents appd）
（vla regen adoc acactiveviewport）
（setq*错误*旧错误
div错误零
)
;;;  （命令“.u undo”“\u end”）
（普林斯）
)
（提示“\n”）
（提示“\n***键入D10以执行***\n”）
（普林斯）~'J'~

fizo当你修改它时，可以从属性txt中取（sta：）部分，并且在这段代码中，cahinage变为1+975，它再次从1+0.00开始，而不是2+0.00
你能更正密码并把它贴在朋友身上吗
谢谢和问候

白驹
babumonbaiju@yahoo.co.in

fixo · 发表于 2022-7-6 13:18:09

白驹，
我会重写它，但你需要删除你的
从这个帖子发帖
请按照论坛规则开始新的帖子
相反

~'J'~

[编程交流] 自动更改颜色对象

发表回复

精选推荐