本帖最后由 669423907 于 2012-8-29 21:19 编辑
;; 改图元图层
(defun c:tt ()
(gtc "DIM")
(princ)
)
(defun gtc (la / ss k)
(if (setq ss (ssget))
(progn
(setq k -1)
(repeat (sslength ss)
(vla-put-layer
(vlax-ename->vla-object (ssname ss (setq k (1+ k))))
"DIM"
)
)
(setvar "clayer" "DIM")；改院长这里
)
)
)
都说了，加
加(command "clayer""dim" )
...测试还是改不了当前层？...
建议楼主附上调试用样图指出所需的效果
本帖最后由 半听可乐 于 2012-8-29 22:07 编辑
669423907 发表于 2012-8-29 21:16 http://bbs.mjtd.com/static/image/common/back.gif
;; 改图元图层
(defun c:tt ()
(gtc "DIM")
不好意思，加哪里？还有就是我类似的操作很多，程序是不是要改很多地方？
(vl-load-com)
;冷水
(defun c:sw()(gtc "SP_W"))
(defun c:sj()(gtc "SJ_J"))
(defun c:sjs()(gtc "SJ_JS"))
(defun c:sj1()(gtc "SJ_J1"))
(defun c:sj2()(gtc "SJ_J2"))
(defun c:sj3()(gtc "SJ_J3"))
(defun c:sj4()(gtc "SJ_J4"))
(defun c:sj5()(gtc "SJ_J5"))
(defun c:sjl()(gtc "SJSTK"))
(defun c:sjb()(gtc "SJBLK"))
(defun c:sj5()(gtc "SJ_J5"))
;此处省略若干行类似上面的语句
(defun gtc (tcm /ss k ent obj);改图层子程序
(if (setq ss (ssget))
(progn
(setq k 0)
(repeat (sslength ss)
(setq ent (ssname ss k))
(setq obj (vlax-ename->vla-object ent))
(vla-put-layer obj tcm)
(setq k (1+ k))
)
))
(princ)
)
真乃风马牛不相及也
选择这条线输入sw，然后这条线就从图层“SP_HOLE”移至图层“SP_W”
命令 sw 对映 移至图层“SP_W”
那么其他的又怎么个对映法
况且也不见有 sw 的命令,楼主如此惜墨,无怪乎没人对得上号...
本帖最后由 namezg 于 2012-8-30 21:55 编辑
;;;-------------------------------------------------------------------------------------------------------------------
;;;★改图元图层
;;;By print1985 明经社区
;;;-------------------------------------------------------------------------------------------------------------------
(vl-load-com)
;冷水
(defun c:sw()(gtc "SP_W"))
(defun c:sj()(gtc "SJ_J"))
(defun c:sjs()(gtc "SJ_JS"))
(defun c:sj1()(gtc "SJ_J1"))
(defun c:sj2()(gtc "SJ_J2"))
(defun c:sj3()(gtc "SJ_J3"))
(defun c:sj4()(gtc "SJ_J4"))
(defun c:sj5()(gtc "SJ_J5"))
(defun c:sjl()(gtc "SJSTK"))
(defun c:sjb()(gtc "SJBLK"))
(defun c:sj5()(gtc "SJ_J5"))
;;;此处省略若干行类似上面的语句！！！
(defun gtc (tcm /ss k ent obj);改图层子程序
(if (or
(setq ss (ssget "I"))
(setq ss (ssget))
)
(progn
(setq k 0)
(repeat (sslength ss)
(setq ent (ssname ss k))
(setq obj (vlax-ename->vla-object ent))
(vla-put-layer obj tcm)
(setq k (1+ k))
)
(setvar "clayer" tcm)
))
(princ)
)
...想要的效果...画一条线...
楼主此例没有说服力...
修订 院长的代码
(defun gtc (la / ss k)
(if (setq ss (ssget))
(progn
(setq k -1)
(repeat (sslength ss)
(vla-put-layer
(vlax-ename->vla-object (ssname ss (setq k (1+ k))))
la
)
)
(setvar "clayer" la)
)
)
)
但 选择图元 得在 运行程序 之后...
;; 改图元图层 伪源码方式
(defun c:tt ()
(gtc "DIM")
(princ)
)
(defun gtc (la / ss)
(xyp-MkLa la)
(if (setq ss (ssget))
(xyp-SubUpd ss 8 la)
)
)
Andyhon 发表于 2012-8-29 22:38 static/image/common/back.gif
...想要的效果...画一条线...
楼主此例没有说服力...
我理解你的意思，因为我也要过类似的程序。再说我也是菜鸟。菜鸟比较容易理解菜鸟的意思。现在还没有如何程序能做到如此智能化，你还是得一条条的改。晚上给你个简单一点的。（别人写的）
本帖最后由 669423907 于 2012-8-30 11:46 编辑
Andyhon 发表于 2012-8-29 22:38 http://bbs.mjtd.com/static/image/common/back.gif
...想要的效果...画一条线...
楼主此例没有说服力...
Andyhon 大师，实在不好意思，我点错了。别误会哈。我是和可乐说的。