半听可乐 发表于 2012-8-29 17:27:08

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

本帖最后由 半听可乐 于 2012-8-29 22:05 编辑

“print1985”曾给了我下面的程序,可以将选择的图元移至指定图层(图层信息存在的前提下),
现在我希望增加一个功能:
图元图层移至指定图层后,指定的图层变成当前图层,应该怎么改?

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


想要的效果:打开调试图后当前图层是SP_HOLE,画一条线,选择这条线输入sw,然后这条线就从图层“SP_HOLE”移至图层“SP_W”,并且当前图层也变成“SP_W”


lidaxiu 发表于 2012-8-29 17:27:09

(defun c:sw()(gtc "SP_W")
(COMMAND "LAYER" "SET" "SP_W" ""))
(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)
)

namezg 发表于 2012-8-29 18:22:46

(vl-load-com)
(defun c:sDIM () (gtc "DIM"))
(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))
                        )
                        (setvar "clayer" tcm)
                )
        )
        (princ)
)

半听可乐 发表于 2012-8-29 20:14:45

namezg 发表于 2012-8-29 18:22 static/image/common/back.gif
(vl-load-com)
(defun c:sDIM () (gtc "DIM"))
(defun gtc (tcm /ss k ent obj);改图层子程序


不管用,还是原来的效果

669423907 发表于 2012-8-29 20:19:57

(defun c:2()
(setq ss (ssget"i"))
(command "layer" "m" "2虚线" "c" "251" "" "lw" "0.13" "" "l" "DASHED" "" "")
(if ss(command "change" ss "" "P" "la" "2虚线" "c" "byl" "lw" "byl" "lt" "byl" ""
))(princ))

半听可乐 发表于 2012-8-29 20:29:55

669423907 发表于 2012-8-29 20:19 static/image/common/back.gif
(defun c:2()
(setq ss (ssget"i"))
(command "layer" "m" "2虚线" "c" "251" "" "lw" "0.13" "" "l" "DA ...

程序功能是满足了,但从个人习惯来说,我都是插入图块(含很多预先设置的图层信息)来建立图层的,用你的程序我还得一条一条改,有点麻烦,能不能直接在我发的程序上改呢?我感觉那个很好用

namezg 发表于 2012-8-29 20:36:27

本帖最后由 namezg 于 2012-8-29 20:36 编辑

我给你改的没有问题啊

669423907 发表于 2012-8-29 20:39:19

我不会改,爱莫能助!

669423907 发表于 2012-8-29 20:44:10

加(command "clayer""dim" )

xyp1964 发表于 2012-8-29 20:55:30

本帖最后由 xyp1964 于 2012-8-30 07:59 编辑


;; 改图元图层
(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))))
          la;"DIM"
      )
      )
      (setvar "clayer" la)
    )
)
)
页: [1] 2 3
查看完整版本: 小程序求助:图元移至指定图层并将指定图层设为当前