请帮忙修改3.0晓东工具箱里保留图层和恢复操作的lisp

jpff

请哪位大虾能帮修改下，用在cad2012 win7 32下，万分感谢！！！
(defun c:bl (/ e lyr lyrl clr el sLyrl n)
  (xdrx_begin)
  (while (setq e (xdrx_entsel "\n拾取要保留图层上的实体<结束>:"))
    (setq lyr (xdrx_getentdxf 8))
    (if (not (member lyr lyrl))
      (progn
        (setq lyrl (cons lyr lyrl))
        (redraw (car e) 3)
        (setq el (cons (car e) el))
        (xdrx_Pickset_Redraw (ssget "x" (list (cons 8 lyr))))
        (prompt (strcat "\n选中了\"" (setq sLyrl (xdrx_String_Join
                                                                   (reverse lyrl)
                                                                   ","
                                                 )
                                     )
                        "\"层!"
                )
        )
      )
    )
  )
  (if lyrl
    (progn
      (xdrx_object_get "layer")
      (while (setq e (xdrx_object_next))
        (if (not (wcmatch (car e) sLyrl))
          (progn
            (if (not (xdrx_getxdata (last e) "XDTB_LYR_COLOR"))
              (progn
                (xdrx_setxdata (last e) "XDTB_LYR_COLOR"
                               (xdrx_getentdxf 62) (xdrx_getentdxf 70)
                )
                (xdrx_modent 62 251 70 4)
              )
            )
          )
          (progn
            (if (setq clr (xdrx_getxdata (last e) "XDTB_LYR_COLOR"))
              (progn
                (xdrx_modent 62 (car clr) 70 (cadr clr))
                (xdrx_object_removexdata (last e) "XDTB_LYR_COLOR")
              )
            )
          )
        )
      )
      (foreach n el
        (redraw n 4)
      )
      (xdrx_Pickset_Redraw (ssget "x" (list (cons 8 sLyrl))) t)
    )
  )
  (xdrx_end)
  (princ)
)


;|
   命令：XDTB_LayerRes
   恢复选层保留到原来状态
|;
(defun c:-bl (/ e clr)
  (xdrx_object_get "layer")
  (while (setq e (xdrx_object_next))
    (setq e (cadr e))
    (if (setq clr (xdrx_getxdata e "XDTB_LYR_COLOR"))
      (progn
        (xdrx_modent 62 (car clr) 70 (cadr clr))
        (xdrx_object_removexdata e "XDTB_LYR_COLOR")
      )
    )
  )
  (princ)
)

csharp

既然用 2012 了，那可以用Autocad自己的函数，更方便

游客，如果您要查看本帖隐藏内容请回复

jpff

csharp 发表于 2015-3-27 20:40
既然用 2012 了，那可以用Autocad自己的函数，更方便
**** 本内容被作者隐藏 ****

非常感谢您的回复。您的lsp是关闭其他图层和恢复图层，xd那个好像是“图层工具”-“选层锁定”，具体功能是锁定要编辑的层，关掉（不是关掉看不见了而是以灰色显示）其他层。这样编辑的时候还能参考以灰色显示的其他层。能实现吗？？再次感谢。

csharp

jpff 发表于 2015-3-27 22:04
非常感谢您的回复。您的lsp是关闭其他图层和恢复图层，xd那个好像是“图层工具”-“选层锁定”，具体功能 ...

修改几处即可

游客，如果您要查看本帖隐藏内容请回复

dbx5511

谢谢分享！

newer

楼主，每日插件里面已经提供了新的图层处理软件的版本了。

jpff

csharp 发表于 2015-3-27 23:45
修改几处即可
**** 本内容被作者隐藏 ****

太好了，非常感谢您。还能麻烦您帮我修改以下几个程序吗？
;;;命令：chval
;;;可以多选，可修改为输入的具体数值，也可以根据输入的比例，“缩放”该值。
(defun c:cc (/ ss tf val e tf1 #get_val val1)
  (defun #get_val (/ p10 p11)
    (setq p10 (xdrx_getentdxf 10)
      p11 (polar p10 (xdrx_getentdxf 50) (distance
                              (xdrx_getentdxf 13)
                              (xdrx_getentdxf 14)
                        )
          )
    )
    (rtos (distance p10 p11) 2 0)
  )
  (while (progn
      (prompt "\n请选取要修改的尺寸标注<退出>:")
      (setq ss (ssget '((0 . "dimension"))))
     )
    (if (not tf)
      (progn
    (setq tf t)
    (initget 6 "1 2")
    (setq tf1 (getkword "\n请输入选项[1:自身变比 2:取输入值]<1>:"))
    (if (not tf1)
      (setq tf1 1)
    )
    (initget 6)
    (setq val (getreal (strcat "\n请输入尺寸文字" (if (= tf1 1)
                            "缩放比例"
                            "新值"
                              ) (if #val_z
                              (strcat "<"
                                  (rtos #val_z
                                    2 1
                                  ) ">"
                              )
                              ""
                            ) ":"
              )
          )
    )
    (if (not val)
      (setq val #val_z)
      (setq #val_z val)
    )
      )
    )
    (xdrx_setsstodb ss 0)
    (while (setq e (xdrx_getentdata 0))
      (setq val1 (if (= "" (xdrx_getentdxf 1))
          (#get_val)
          (xdrx_getentdxf 1)
         )
      )
      (xdrx_modent 1 (if (= tf1 1)
              (rtos (* (atof val1) val) 2 0)
              (rtos val 2 0)
            )
      )
      (entupd e)
    )
  )
  (princ)
)
====
;;;命令：resval
;;;将选择的标注，恢复标注值到原始状态下。
(defun c:hf (/ ss e)
  (while (progn
      (prompt "\n请选取要恢复原值的尺寸标注<退出>:")
      (setq ss (ssget '((0 . "dimension"))))
     )
    (xdrx_setsstodb ss 0)
    (while (setq e (xdrx_getentdata 0))
      (xdrx_modent 1 "")
      (entupd e)
    )
  )
  (princ)
)
＝＝＝＝修改标注字高＝＝＝
;;命令：chdimh
;;对不同比例画图很方便的解决方法和修改尺寸文字配合用。
(defun c:zg (/ tf tf1 #mod_h e val)
  (defun #get_h (blkna / bl e ed old_h new_h)
    (setq bl (tblsearch "block" blkna))
    (setq e (cdr (assoc -2 bl)))
    (while (/= "MTEXT" (cdr (assoc 0 (entget e))))
      (setq e (entnext e))
    )
    (cdr (assoc 40 (entget e)))
  )
  (while (progn
      (prompt "\n请选取要修改字高的尺寸标注<退出>:")
      (setq ss (ssget '((0 . "dimension"))))
     )
    (if (not tf)
      (progn
    (setq tf t)
    (initget 6 "1 2")
    (setq tf1 (getkword "\n请输入选项[1:变比 2:实际字高]<1>:"))
    (if (not tf1)
      (setq tf1 1)
    )
    (initget 6)
    (setq val (getreal (strcat "\n请输入尺寸文字" (if (= tf1 1)
                            "缩放比例"
                            "新字高"
                              ) (if #val_h
                              (strcat "<"
                                  (rtos #val_h
                                    2 1
                                  ) ">"
                              )
                              ""
                            ) ":"
              )
          )
    )
    (if (not val)
      (setq val #val_h)
      (setq #val_h val)
    )
      )
    )
    (xdrx_setsstodb ss 0)
    (while (setq e (xdrx_getentdata 0))
      (setq bl (xdrx_getentdxf 2))
      (xdrx_setxdata4 e "ACAD" "DSTYLE" (list 140 (if (= tf1 1)
                            (* (#get_h bl) val)
                            val
                          )
                    )
      )
    )
  )
  (princ)
)

水沙漠

学习学习！

liulisheng

jreeybin

学习一下，感谢分享

力能

学习了~谢谢！！