求助修改一个不能选择 bylayer 颜色的程序(已解决多谢caoyin版主帮助)
本帖最后由 669423907 于 2011-6-27 12:28 编辑(defun C:sxs(/ ss ent)
(and (setq SS (entsel "\n选色"))
(setq ENT (entget (car SS)))
(assoc 62 ENT)
(sssetfirst NIL (ssget(list( assoc 62 ENT)))))
(princ))
不知要怎么改才能让其可以选择 bylayer 颜色的对象?
(defun C:SXS (/ EN ENT COL LAYS SS)
(if (setq EN (entsel "\n选色"))
(progn
(setq ENT (entget (car EN))
COL (assoc 62 ENT)
)
(or COL
(setq COL (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 ENT)))))
)
(setq LAYS "")
(while (setq CE (tblnext "LAYER" (not CE)))
(if (member COL CE)
(setq LAYS (strcat LAYS (cdr (assoc 2 CE)) ","))
)
)
(setq SS
(ssget (list '(-4 . "<OR")
COL
'(-4 . "<AND")
(c** 8 LAYS)
'(62 . 256)
'(-4 . "AND>")
'(-4 . "OR>")
)
)
)
(if SS (sssetfirst nil SS))
)
)
(princ)
) 本帖最后由 caoyin 于 2011-6-17 19:58 编辑
CONS 函数怎么变成 c** 这个恐怕lisp解决不了吧,只能用vlisp才行。 回复 caoyin 的帖子
非常感谢版主热情帮忙!
本想借鉴一下,然后自己试着改一个动态修改线型比例的程序,
看来小生的道行是很不到家的了!
还请版主再次帮忙啦
(defun c:bl(/ ss alts pt gr s1 lt zq newscale)
(prompt "\n 请选择物体: ")
(setq ss (ssget)
alts (getvar "LTSCALE")
pt (getpoint "\n请选择一个点: ")
)
(while (= (car (setq gr (grread nil 5 0))) 5)
(redraw)
(grdraw (cadr gr) pt 1 1)
(setq i -1)
(while (setq s1 (ssname ss (setq i (1+ i))))
(if (setq lt (cdr (assoc 6 (entget s1))))
(progn
(setq zq(cdr (assoc 40 (tblsearch "ltype" lt)))
newscale (/ (distance (cadr gr) pt) zq alts 1.)
)
(vla-put-LinetypeScale (vlax-ename->vla-object s1) newscale)
)
)
)
)
(redraw)
(princ)
)
也是不能选择 bylayer 的线型! 回复 chengx2000 的帖子
caoyin 版主的程序可以啦!
页:
[1]