小程序求助：图元移至指定图层并将指定图层设为当前

669423907

;; 改图元图层
(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" )

Andyhon

...测试还是改不了当前层？...
建议楼主附上调试用样图指出所需的效果

半听可乐

669423907 发表于 2012-8-29 21:16
;; 改图元图层
(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)
)

Andyhon

真乃风马牛不相及也

选择这条线输入sw，然后这条线就从图层“SP_HOLE”移至图层“SP_W”

命令 sw 对映   移至图层“SP_W”
那么其他的又怎么个对映法

况且也不见有 sw 的命令,楼主如此惜墨,无怪乎没人对得上号...

namezg

;;;-------------------------------------------------------------------------------------------------------------------
;;;★改图元图层
;;;  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)
)

Andyhon

...想要的效果...画一条线...

楼主此例没有说服力...

Andyhon

修订 院长的代码

2. 
   
3. (defun gtc (la / ss k)
   
4.   (if (setq ss (ssget))
   
5.     (progn
   
6.       (setq k -1)
   
7.       (repeat (sslength ss)
   
8.         (vla-put-layer
   
9.           (vlax-ename->vla-object (ssname ss (setq k (1+ k))))
   
10.           la
    
11.         )
    
12.       )
    
13.       (setvar "clayer" la)
    
14.     )
    
15.   )
    
16. )
    

<br /> (defun gtc (la / ss k)<br />   (if (setq ss (ssget))<br />     (progn<br />       (setq k -1)<br />       (repeat (sslength ss)<br />         (vla-put-layer<br />           (vlax-ename->vla-object (ssname ss (setq k (1+ k))))<br />           la<br />         )<br />       )<br />       (setvar "clayer" la)<br />     )<br />   )<br /> )<br />

但 选择图元 得在 运行程序 之后...

xyp1964

2. 
   
3. ;; 改图元图层 伪源码方式
   
4. (defun c:tt ()
   
5.   (gtc "DIM")
   
6.   (princ)
   
7. )
   
8. (defun gtc (la / ss)
   
9.   (xyp-MkLa la)
   
10.   (if (setq ss (ssget))
    
11.     (xyp-SubUpd ss 8 la)
    
12.   )
    
13. )

<br /> ;; 改图元图层 伪源码方式<br /> (defun c:tt ()<br />   (gtc "DIM")<br />   (princ)<br /> )<br /> (defun gtc (la / ss)<br />   (xyp-MkLa la)<br />   (if (setq ss (ssget))<br />     (xyp-SubUpd ss 8 la)<br />   )<br /> )

669423907

Andyhon 发表于 2012-8-29 22:38
...想要的效果...画一条线...

楼主此例没有说服力...

我理解你的意思，因为我也要过类似的程序。再说我也是菜鸟。菜鸟比较容易理解菜鸟的意思。现在还没有如何程序能做到如此智能化，你还是得一条条的改。晚上给你个简单一点的。（别人写的）

669423907

Andyhon 发表于 2012-8-29 22:38
...想要的效果...画一条线...

楼主此例没有说服力...

Andyhon 大师，实在不好意思，我点错了。别误会哈。我是和可乐说的。