选择图元，则该图元所在的图层置为当前层

品茗新秀

选择图中图元，则该图元所在的图层置为当前层

springwillow

2. ;;----------------------
   
3. ;;将所选实体层置为当前层
   
4. ;;----------------------
   
5. (defun c:dqc (/ ent ent_data clay)
   
6.   (setq ent (car (entsel (strcat "\n选择物体:"))))
   
7.   (if (/= nil ent)
   
8.     (progn
   
9.       (setq ent_data (entget ent))
   
10.       (setq clay (cdr (assoc 8 ent_data)))
    
11.       (setvar "clayer" clay)
    
12.       (setvar "Cecolor" "ByLayer")
    
13.       (prompt (strcat "\n成功将图层设为<" clay ">："))
    
14.     )
    
15.   )
    
16.   (princ)
    
17. )
    

;;----------------------<br /> ;;将所选实体层置为当前层<br /> ;;----------------------<br /> (defun c:dqc (/ ent ent_data clay)<br />   (setq ent (car (entsel (strcat "\n选择物体:"))))<br />   (if (/= nil ent)<br />     (progn<br />       (setq ent_data (entget ent))<br />       (setq clay (cdr (assoc 8 ent_data)))<br />       (setvar "clayer" clay)<br />       (setvar "Cecolor" "ByLayer")<br />       (prompt (strcat "\n成功将图层设为<" clay ">："))<br />     )<br />   )<br />   (princ)<br /> )<br />

ysq101

楼主求了这么多程序。。。。这些都没学会？？

kwok

CAD08版上自带的命令:  ai_molc

自贡黄明儒

(setvar "clayer" (cdr (assoc 8(entget (car (entsel))))))

yjr111

a  dou(读第三声）

happysheep

我是为了5个明经币来的，现学现卖

2. (defun c:ccc ()
   
3.   (command "_.undo" "be")
   
4.   (if (setq e (car (entsel "\n选择需要置为当前层的对象:")))
   
5.     (progn
   
6.       (setq obj (vlax-ename->vla-object e))
   
7.       (setq layer (vlax-get-property obj 'Layer))
   
8.       (vla-put-ActiveLayer
   
9.         (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
   
10.         (vla-item (vla-get-layers doc) layer)
    
11.       )
    
12.     )
    
13.   )
    
14.   (command "_.undo" "e")
    
15.   (princ)
    
16. )

(defun c:ccc ()<br />   (command "_.undo" "be")<br />   (if (setq e (car (entsel "\n选择需要置为当前层的对象:")))<br />     (progn<br />       (setq obj (vlax-ename->vla-object e))<br />       (setq layer (vlax-get-property obj 'Layer))<br />       (vla-put-ActiveLayer<br />         (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))<br />         (vla-item (vla-get-layers doc) layer)<br />       )<br />     )<br />   )<br />   (command "_.undo" "e")<br />   (princ)<br /> )

362896182

;;　命　令　　　　　功　能
;;　　nn　　　　　　将所选图元图层至为当前层
;;    ad            只显示所选图元且仅只有一个，其余冻结
;;    fa            将当前文档所有冻结图层打开
;;    qw            选择不要冻结的图元，可多选
;;    mm            将所选图元，移动到指定图元图层
;;    cf            将所选图元，复制到指定图元图层


;;**********************************************************************
(vl-load-com)
(Defun *Collection* ()
  (setq        *AcadObject* (vlax-get-acad-object)
        *DwgObject*  (vla-get-activedocument *AcadObject*)
        *ModelSpace* (vla-get-modelspace *DwgObject*)
        *Layers*     (vla-get-layers *DwgObject*)
        *Blocks*     (vla-get-blocks *DwgObject*)
        *LineTypes*  (vla-get-linetypes *DwgObject*)
  )
)
(if(not(tblsearch "ltype" "CENTER"));;中心线加载
  (progn
    (*Collection*)
    (vlax-invoke-method *LineTypes* 'Load  "CENTER" "acadiso.lin")
    )
  )
(if(not(tblsearch "ltype" "DASHED"));;虚线加载
  (progn
    (*Collection*)
    (vlax-invoke-method *LineTypes* 'Load  "DASHED" "acadiso.lin")
    )
  )
;;将所选图元图层至为当前层**********************************************
(defun c:nn (/ EntityName VlaName CurrentlyLayer Layer *Layers* *DwgObject* *Blocks* *ModelSpace* *AcadObject* *LineTypes*)
  (*Collection*)
  (if (setq EntityName (Car (Entsel "\n请选择要置为当前层的图元:")))
    (progn
      (setq VlaName           (vlax-ename->vla-object EntityName)
            CurrentlyLayer (vla-get-Layer VlaName)
      )
      (Vlax-For        Layer *Layers*
        (IF (= (Vla-Get-Name Layer) CurrentlyLayer)
          (vla-put-ActiveLayer *DwgObject* Layer)
        )
      )
    )
  )
  (prin1)
)
;;只显示所选图元且仅只有一个，其余冻结*************************************
(Defun c:ad (/ EntityName VlaName CurrentlyLayer Layer *Layers* *DwgObject* *Blocks* *ModelSpace* *AcadObject* *LineTypes*)
  (*Collection*)
  (if (setq EntityName (Car (Entsel "\n选择不冻结的图元<仅一个>:")))
    (progn
      (setq VlaName           (vlax-ename->vla-object EntityName)
            CurrentlyLayer (vla-get-Layer VlaName)
      )
      (VLAX-FOR        Layer *Layers*
        (if (= (vla-get-name Layer) CurrentlyLayer)
          (vla-put-ActiveLayer *DwgObject* Layer)
        )
      )
      (VLAX-FOR        Layer *Layers*
        (if (/= (vla-get-name Layer) CurrentlyLayer)
          (vla-put-Freeze Layer -1)
        )
      )
    )
  )
  (prin1)
)
;;将当前文档所有冻结图层打开**********************************************
(Defun c:fa (/ Layer *Layers* *DwgObject* *Blocks* *ModelSpace* *AcadObject* *LineTypes*)
  (*Collection*)
  (VLAX-FOR Layer *Layers*
    (if        (/= (vla-get-Freeze Layer) :vlax-false)
      (progn
        (vla-put-Freeze Layer 0)
        (vla-put-LayerOn Layer -1)
        (vla-put-lock Layer 0)
      )
    )
  )
  (vlax-invoke-method *DwgObject* 'regen acactiveviewport)
  (prin1)
)
;;选择不要冻结的图元，可多选*********************************************
(Defun c:qw(/  *Layers* *DwgObject* *Blocks* *ModelSpace* *AcadObject*
              selectcollection VlaObjectList index LayerNameList Layer VlaObject)
  (*Collection*)
  (if (setq selectcollection (ssget))
    (progn
      (setq index 0 VlaObjectList nil LayerNameList nil)
      (repeat (sslength selectcollection)
        (setq VlaObjectList
               (append VlaObjectList
                       (list(vlax-ename->vla-object (ssname selectcollection index))))
              )
        (setq index (1+ index))
      )
      (foreach VlaObject  VlaObjectList
        (setq LayerNameList(append LayerNameList(list (vla-get-layer VlaObject))))
        )
      (VLAX-FOR        Layer  *Layers*
        (if
          (not (= (vla-get-name layer)(vla-get-name (vla-get-activelayer *DwgObject*))))
           (if (= (vla-get-name layer) (nth 0 LayerNameList))
             (vla-put-activelayer *DwgObject* Layer))
          )
        )
      (VLAX-FOR        Layer  *Layers*
        (if (not (vl-position(vla-get-name Layer)LayerNameList))
          (vla-put-freeze Layer -1)
          )                  ;endif
        )
      )        ;end progn
    );endif
  (prin1)
)
;;将所选图元，移动到指定图元图层
(Defun c:mm(/  *Layers* *DwgObject* *Blocks* *ModelSpace* *AcadObject* *LineTypes*
            EntityCollection TargetObject index VlaObjectList TargetVlaObject
            TargetLayerName VlaObject)
  (*Collection*)
  (if(setq EntityCollection(ssget))
     (if(setq TargetObject(car(entsel "\n 选择目标图层的图元:")));Target 目标
        (progn
          (setq index 0 VlaObjectList nil)
          (repeat (sslength EntityCollection)
            (setq VlaObjectList(append VlaObjectList(list(vlax-ename->vla-object(ssname EntityCollection index)))))
            (setq index(1+ index))
          )
          (setq TargetVlaObject(vlax-ename->vla-object TargetObject))
          (setq TargetLayerName(vla-get-layer TargetVlaObject))
          (foreach VlaObject VlaObjectList
            (vla-put-layer VlaObject TargetLayerName)
          )
        )
      )
    )
  (prin1)
)
;;将所选图元，复制到指定图元图层
(Defun c:cf(/ EntityCollection TargetObject index VlaObjectList TargetVlaObject TargetLayerName VlaObject)
  (if(setq EntityCollection(ssget))
    (if(setq TargetObject(car(entsel "\n指定复制图元的目标图层:")))
      (progn
          (setq index 0 VlaObjectList nil)
          (repeat (sslength EntityCollection)
            (setq VlaObjectList(append VlaObjectList(list(vlax-ename->vla-object(ssname EntityCollection index)))))
            (setq index(1+ index))
          )
          (setq TargetVlaObject(vlax-ename->vla-object TargetObject))
          (setq TargetLayerName(vla-get-layer TargetVlaObject))
        (foreach VlaObject VlaObjectList
          (vla-put-layer (vlax-invoke-method VlaObject 'Copy) TargetLayerName)
          )
        )
      )
    )
  (prin1)
)