求助，如何能够让关闭的图层打开，让打开的图层关闭

vanadis91 · 发表于 2014-3-21 23:22:31

问下，如何能够让关闭的图层打开，让打开的图层关闭，网上找了下，觉得这句可以实现，但是因为不懂编程，不知道完整的应该怎么写(vlax-put obj "layeron" (* -1 (1+ (vlax-get obj "layeron"))))

77077 · 发表于 2014-3-22 03:06:24

就按你说的去做,打开添加到一个list然后关闭,反之关闭的打开

ZZXXQQ · 发表于 2014-3-22 08:10:03

遍历图层，如图层打开就关闭，反之就打开。

vanadis91 · 发表于 2014-3-22 12:09:59

关键是我不会编程额。。。。大侠们，帮小弟写写完整吧

357785513 · 发表于 2014-3-23 22:12:39

这个建筑提得有创意，见意版主给加5个经验值

362896182 · 发表于 2014-3-23 23:15:18

;;说明:图层控制及相关
;;程式所有权归设计者:郭维
;;日期：2014年03月09日
;;　命　令　　　　　功　能
;;　　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)
)

;;说明:图层控制及相关 
;;程式所有权归设计者:郭维 
;;日期：2014年03月09日 
;;　命　令　　　　　功　能 
;;　　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) 
)

362896182 · 发表于 2014-3-23 23:17:47

;;说明:图层控制及相关
;;程式所有权归设计者:郭维
;;日期：2014年03月09日
;;　命　令　　　　　功　能
;;　　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)
)

;;说明:图层控制及相关 
;;程式所有权归设计者:郭维 
;;日期：2014年03月09日 
;;　命　令　　　　　功　能 
;;　　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) 
)

ZZXXQQ · 发表于 2014-3-24 08:08:40

本帖最后由 ZZXXQQ 于 2014-4-8 09:41 编辑

游客，本帖隐藏的内容需要发帖数高于 4 才可浏览，你当前发帖数只有 0

llsheng_73 · 发表于 2014-3-24 10:00:28

本帖最后由 llsheng_73 于 2014-4-8 22:23 编辑

图层开关切换

(setq la(tblnext "LAYER" T))
(while la(setq la(entget(tblobjname"LAYER"(cdr(assoc 2 la)))))
(entmod(subst(cons 62(- 0(cdr(assoc 62 la))))(assoc 62 la)la))
(setq la(tblnext "LAYER" nil)))

锁定图层解锁，未锁图层加锁

(setq la(tblnext"layer" t))
(while la(setq la(entget(tblobjname"layer"(cdr(assoc 2 la)))))
(entmod(subst(cons 70(+(cdr(assoc 70 la))4))(assoc 70 la)la))
(setq la(tblnext"layer"nil)))

图层冻结、解冻

(setq la(tblnext"layer" t))
(while la(setq la(entget(tblobjname"layer"(cdr(assoc 2 la))))dxf70(cdr(assoc 70 la)))
(entmod(subst(cons 70(+(if(=(rem dxf70 2)1)-1 1)dxf70))(assoc 70 la)la))
(setq la(tblnext"layer"nil)))

freehand8008 · 发表于 2014-3-24 10:07:52

挺咸蛋的需求哈哈

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

[提问] 求助，如何能够让关闭的图层打开，让打开的图层关闭

相关帖子

点评