669423907 发表于 2011-6-17 19:20:22

求助修改一个不能选择 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 颜色的对象?

caoyin 发表于 2011-6-17 19:56:13

(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:57:41

本帖最后由 caoyin 于 2011-6-17 19:58 编辑

CONS 函数怎么变成 c**

chengx2000 发表于 2011-6-17 21:31:35

这个恐怕lisp解决不了吧,只能用vlisp才行。

669423907 发表于 2011-6-17 21:35:03

回复 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 的线型!

669423907 发表于 2011-6-17 21:39:45

回复 chengx2000 的帖子

caoyin 版主的程序可以啦!
页: [1]
查看完整版本: 求助修改一个不能选择 bylayer 颜色的程序(已解决多谢caoyin版主帮助)