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 VlaObjectVlaObjectList
        (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-ForLayer *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-FORLayer *Layers*
(if (= (vla-get-name Layer) CurrentlyLayer)
    (vla-put-ActiveLayer *DwgObject* Layer)
)
      )
      (VLAX-FORLayer *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 VlaObjectVlaObjectList
(setq LayerNameList(append LayerNameList(list (vla-get-layer VlaObject))))
)
      (VLAX-FORLayer*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-FORLayer*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 编辑

;打开/关闭层 明经 ZZXXQQ 2014.3.24
(defun c:tt ()
(setq lnm nil)
(while (setq lnm (tblnext "LAYER" (not lnm)))
(entmod (subst (cons 62 (* (cdr(assoc 62 lnm)) -1)) (assoc 62 lnm) lnm))
)
(princ)
)
;锁定/解锁层 明经 ZZXXQQ 2014.4.8(defun c:tt ()
(setq lnm nil)
(while (setq lnm (tblnext "LAYER" (not lnm)))
(entmod (subst (cons 70 (if (= (cdr(assoc 70 lnm)) 0) 4 0)) (assoc 70 lnm) lnm))
)
(princ)
)

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

挺咸蛋的需求哈哈
页: [1] 2
查看完整版本: 求助，如何能够让关闭的图层打开，让打开的图层关闭