[LISP程序]：两个有用的lisp

pxt2001

以前在晓东CAD空间里只是下载lisp
刚刚学习lisp编程，自己编了两个，请高手指点。
1　将多个文字改为另一文字gz
2　将填充图层显示后置hz（打印出图时，需将墙体和柱子填充显示淡一些，将填充图层后置，可保证填充不遮盖边线和其它线条）

[php]
;;;将所选择的多个文字改为另外同一个文字gz
(defun c:gz (/ ss ss2 en2_data en2_type new_str_list)
  (princ "\n请选择要改变的文字:\n")
  (setq ss (ssget (list (cons 0 "TEXT"))))
  (setq ss2 (entsel "\n请选取新文字:"))
;;;以下为判断选取的新文字，如果为空或不是文字对象--------------
;;;循环要求重新取
  (while (or (= ss2 nil)
             (/= (cdr (assoc 0 (entget (car ss2))))
                 "TEXT"
             )
         )
    (alert "\n未选中文字，请重新选取!")
    (setq ss2 (entsel "\n未选中文字，请重新选取:"))
  )
;;;---------------------------------------------------------------------------------------------------------
  (setq en2_data (entget (car ss2)))
  (setq en2_type (cdr (assoc 0 en2_data)))
  (if (= en2_type "TEXT")
    (progn
      (setq new_str_list (assoc 1 en2_data))
      (chgtext)
      (prompt (strcat "\n共有"
                      (itoa (sslength ss))
                      "个文字改变成:"
                      (cdr new_str_list)
              )
      )
    )
  )
  (princ)
)
;;;以下是改变文字子程序----------------------------------------------------------------
(defun chgtext (/ n en)
  (setq n 0)
  (repeat (sslength ss)
    (setq en (ssname ss n))
    (setq en_data (entget en))
    (setq en_data (subst new_str_list (assoc 1 en_data) en_data))
    (entmod en_data)
    (setq n (1+ n))
  )
)

;;;--------------------------------------------------------------------------------------------------------
(defun c:hz (/ layn ss1 lay_data)
  (setvar "cmdecho" 0)
  (setq layn (getstring "\n请输入要显示后置的图层名称<fill>:"))
  (if (= layn "")
    (setq layn "fill")
  )
  (setq lay_data (tblsearch "layer" layn)) ;搜索图层layn
;;--------------------------------------------------------------------
;;;while循环，图层layn“不存在”为真时，循环要求重新输入图层，
;;;直至“不存在”为假时，跳出循环!!
  (while (= lay_data nil)
    (alert (strcat "图层< " layn " >不存在,try again!"))
    (setq layn (getstring "\n请重新输入要<<显示后置>>的图层名:"))
    (setq lay_data (tblsearch "layer" layn))
  )
  ;;-------------------------------------------------------------------
  (setq ss1 (ssget "X" (list (cons 8 layn))))
  (command "draworder" ss1 "" "b")
  (princ (strcat "\n<" layn ">层上所有对象<<显示后置>>!"))

  (setvar "cmdecho" 1)
  (princ)
)
[/php]

huiling6868

我下了,佷好用,你能否编个修改一个字整个图形上相同的字多变为同一个新字.做好后能否发到我的信箱.
E-MAIL:HUILING6868@163.COM

ss1025

楼主写的挺好啊。
不过，在坛子中已经有了。希望楼主再接再厉。

li809

楼上说有了，在哪，没找到

pxt2001

回复二楼：
将图面上多个相同的文字，改为另一文字，可以用CAD自带的FIND（查找替换）命令。FIND命令可以在全图范围内替换或选择范围内替换。不妨试一试！

bububa918

楼主，填充图层显示后置程序，能不能将输入图层名改为可以直接点取对应图元
那位可以修改一下

pxt2001

回复6楼
每个人的作图习惯不一样，用来作填充的图层名也不一样；只须将下列代码中的两处“fill”改为你自己的用作“填充”的图层名：
例如你习惯用hatch层作填充图层，将程序两处fill改为hatch。需要将hatch层后置时，按空格或Enter响应默认值，岂不很省事！
[php]
(setq layn (getstring "\n请输入要显示后置的图层名称<fill>:"))
  (if (= layn "")
    (setq layn "fill")
  )
[/php]

huiling6868

回复五楼:
              CAD中的不好用,我是说相楼主编的一样,点击旧字再点击新字整图中所有同旧字一样得字多变为新字.

xyp1964

6楼，试试下面：
[php]
;;;加载通用函数
;;;下载：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
(load "xyp_lib")

;;;旧文字完全匹配修改为新文字
(defun c:test1 ()
  (cmdla0)
  (while (not (setq txt1 (entsel "\n请选旧文字 : "))))
  (while (/= (cdr (assoc 0 (entget (car txt1)))) "TEXT")
    (setq txt1 (entsel "\n未选中文字，请重选旧文字 : "))
  )
  (while (not (setq txt2 (entsel "\n请选新文字 : "))))
  (while (/= (cdr (assoc 0 (entget (car txt2)))) "TEXT")
    (setq txt2 (entsel "\n未选中文字，请重选新文字 : "))
  )
  (setq        txt1 (dxf 1 (entget (car txt1)))
        txt2 (dxf 1 (entget (car txt2)))
  )
  (setq        ss (ssget "X" (list (cons 0 "TEXT") (cons 1 txt1)))
        n  -1
  )
  (while (setq s1 (ssname ss (setq n (1+ n))))
    (sub_upd s1 1 txt2)
  )
  (cmdla1)
)

;;;将所选择的多个文字改为另外同一个文字
(defun c:test2 ()
  (cmdla0)
  (princ "\n请选择要改变的文字 : ")
  (setq ss (ssget (list (cons 0 "TEXT"))))
  (while (not (setq ss2 (entsel "\n请选取新文字 : "))))
  (while (/= (cdr (assoc 0 (entget (car ss2)))) "TEXT")
    (setq ss2 (entsel "\n未选中文字，请重新选取 : "))
  )
  (setq        txt2 (dxf 1 (entget (car ss2)))
        n    -1
  )
  (while (setq s1 (ssname ss (setq n (1+ n))))
    (sub_upd s1 1 txt2)
  )
  (cmdla1)
)

;;;将选择的图层显示后置
(defun c:tchz ()
  (cmdla0)
  (while (not (setq s1 (entsel "\n请选取要显示后置的图层物体 : ")))
  )
  (setq layn (dxf 8 (entget (car s1))))
  (setq ss1 (ssget "X" (list (cons 8 layn))))
  (command "draworder" ss1 "" "b")
  (command "regen")
  (cmdla1)
)
[/php]

ahfy

格式刷不就是修改格式的吗。关于对象后置的问题，AUTOCAD中这样的工具栏，很容易将对象后置。

huiling6868

九楼的:
      下了并安装了,用的很好,麻烦你能否编一个图层前置的命令,先谢谢了!

xyp1964

前、后置的区别在于命令draworder选项的B和F。
[php]
;;;将选择的图层显示前置
(defun c:tcqz ()
  (cmdla0)
  (while (not (setq s1 (entsel "\n请选取要显示前置的图层物体 : "))))
  (setq layn (dxf 8 (entget (car s1)))
        ss1 (ssget "X" (list (cons 8 layn))))
  (command "draworder" ss1 "" "F")
  (command "regen")
  (cmdla1)
)
[/php]

huiling6868

白银长老"
      LISP中"n请选取要显示后置的图层物体"后置是不是错了,应该是前置对不对啊?

xyp1964

最初由 huiling6868 发布
[B]白银长老"
      LISP中"n请选取要显示后置的图层物体"后置是不是错了,应该是前置对不对啊? [/B]

确实是错了！

已经修改。

huiling6868

再麻烦白银长老,能否编一个标注轴线序号的LISP,应我的在2002里不能用,还有我不想用别的专业软件,圈是800,字是黑体,谢谢你.