自动更改颜色对象
你好通过将所有对象（即文本、尺寸、图案填充、图纸文件中除标题栏及其标题栏属性外的所有外部参照）的颜色内容更改为灰色，使其看起来像背景色，我正在处理数百个图形。我面临的问题是，一些图层对象的对象颜色不是“bylayer”。有没有人有lisp例程可以运行&自动更改您选择的所有对象的所有颜色？非常感谢您的回复。 当你在等待一个好的灵魂为你写一个lisp时，你可以用键盘手动操作：-
命令：-ch（回车）
更改
选择对象：全部（Enter）
找到2254个
378人不在当前空间。
选择对象：（输入）
指定更改点或[特性]：p（输入）
输入要更改的特性：c（输入）
输入新颜色：bylayer（Enter）
输入要更改的特性：（输入）
这不适用于嵌入块中的任何行，您必须分解这些行，但它可以在您等待时为您提供一些操作。 像这样的？
(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
http://www.cadtutor.net/forum/showthread.php?t=31017 所有层和块的Lisp颜色变化
外部参照
~'J'~
ColorX-更改图形所有对象的颜色。所有层解锁和解冻
颜色外部参照仅在当前会话中更改颜色外部参照。所有层解锁和解冻
ColorXL-更改图形所有对象的颜色。锁定层和冻结层上的对象将被忽略
颜色外部参照仅在当前会话中更改颜色外部参照。锁定层和冻结层上的对象将被忽略
COLORXLAY-更改外部参照层的颜色
И от меня спасибо
Успехов
~'J'~ 海菲佐
你修改过这个代码吗
代码：
（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
白驹，
我会重写它，但你需要删除你的
从这个帖子发帖
请按照论坛规则开始新的帖子
相反
~'J'~
页:
[1]