[求助]：在lisp程序中如何设置某层颜色线型线宽随层？

changyq · 发表于 2006-6-16 17:14:16

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

问题与标题一致。

似水无痕 · 发表于 2006-6-18 00:17:48

终于成功了，楼主试试行么？

(defun c:test (/ ent ss1 slth n ent1 ent2 color object1)
(setq ent (entget (car (entsel "\n请选择：")))
ss1 (ssget "_X" (list (assoc 8 ent)))
slth (sslength ss1)
n 0
)
(if (/= slth 0)
(repeat slth
(setq ent1 (ssname ss1 n)
object1 (vlax-ename->vla-object ent1)
)
(vlax-put-property object1 'linetype "bylayer")
(vlax-put-property object1 'lineweight -1)
(setq ent1 (vlax-vla-object->ename object1)
ent2 (entget ent1)
color (car (member (assoc 62 ent2) ent2))
)
(if (/= color nil)
(progn
(entdel ent1)
(setq ent2 (vl-remove (assoc 62 ent2) ent2))
(entmake ent2)
)
)
(setq n (1+ n))
)
)
(princ)
)

eachy · 发表于 2006-6-18 03:57:33

1 (if (/= slth 0) 条件可以用

(if (setq e (entget (car (entsel))) ss (ssget "x" (list (assoc 8 e))))
(progn
....

2 (vlax-put-property object1 'linetype "bylayer") -> (vla-put-linetype object1 acBylayer)

3 (vlax-put-property object1 'lineweight -1) -> (vla-put-lineweight object1 acBylayer)

4 后面的颜色部分不用那么代码，用一句话代替

(vla-put-color object1 acBylayer)

复制代码

似水无痕 · 发表于 2006-6-18 13:44:47

谢谢eachy斑竹！
我将程序更改后，当运行至(vla-put-linetype object1 acBylayer)句时提示“ 错误: Automation 错误。未找到主键”，程序运行终止！
更改后代码如下：

(defun c:test (/ ent ss1 slth n ent1 object1)
(setq ent (entget (car (entsel "\n请选择：")))
ss1 (ssget "_X" (list (assoc 8 ent)))
slth (sslength ss1)
n 0
)
(if (/= slth 0)
(repeat slth
(setq ent1 (ssname ss1 n)
object1 (vlax-ename->vla-object ent1)
)
(vla-put-linetype object1 acbylayer)
(vla-put-lineweight object1 acBylayer)
(vla-put-color object1 acBylayer)
(setq n (1+ n))
)
)
(princ)
)

eachy · 发表于 2006-6-18 14:22:07

(vla-put-linetype object1 acbylayer) -> (vla-put-linetype object1 "ByLayer")

似水无痕 · 发表于 2006-6-18 14:49:42

OK!成功了，谢谢斑竹！

(defun c:test (/ ent ss1 slth n ent1 object1)
(setq ent (entget (car (entsel "\n请选择：")))
ss1 (ssget "_X" (list (assoc 8 ent)))
slth (sslength ss1)
n 0
)
(if (/= slth 0)
(repeat slth
(setq ent1 (ssname ss1 n)
object1 (vlax-ename->vla-object ent1)
)
(vla-put-linetype object1 "bylayer")
(vla-put-lineweight object1 -1)
(vla-put-color object1 acBylayer)
(setq n (1+ n))
)
)
(princ)
)

fsxm · 发表于 2006-6-18 19:47:42

其实这个不用vlisp还要简单一点不是吗？
[php]
(defun c:test (/ en ss)
  (while (not (setq en (entsel "\n请选择图层对像："))))
  (setq ss (ssget "X"
   (list (assoc 8 (entget (car en))))
   )
  )
  (foreach x (list "C" "LT" "LW")
(command "change" ss "" "p" x "bylayer" "")
  )
)
[/php]

NET-JOB · 发表于 2006-7-13 21:06:59

如何支持多选？

jx2008 · 发表于 2008-10-9 10:33:20

修改支持多选很容易了，修改选择命令为ssget，并增加一个最外层的循环即可。

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：在lisp程序中如何设置某层颜色线型线宽随层？

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子