[原创]：一个批量改标高的程序

gysjy

也许搞结构的朋友有时需要将标高统一修改一个差值。这里提供一个程序可以快捷实现这一功能。该程序在你选择物体后，输入一个差值，则所选物体里的所有标高就都加上了这个差值。需要说明的是程序中针对的标高是位于PUB_DIM层上的TEXT,以及块名为BG、BGZ、BGY的属性块，如果你所要改的标高不在此范围内，可以将程序中的层名或块名改为你需要的名称。
命令名：bbg
[PHP](defun to(n)
  (cdr (assoc n (entget sn)))
)
(princ "\n欢迎使用批量改标高程序！命令名:bbg   == GYSJY  2008.12.24 ==")
(defun c:bbg( / blip e1 en n sn ss tr1 x y y0 y1)
  (command "undo" "g")
  (setq blip (getvar "blipmode"))
  (setvar "blipmode" 0)  
  (setq n 0 bgaoy0 (if bgaoy0 bgaoy0 -0.05)
        ss (ssget '((-4 . "<OR")(-4 . "<AND")(0 . "TEXT")(8 . "PUB_DIM")(-4 . "AND>")
                    (-4 . "<AND")
                    (0 . "INSERT")
                    (-4 . "<OR")(2 . "BGZ")(2 . "BGY")(2 . "BG")(-4 . "OR>")
                    (-4 . "AND>")(-4 . "OR>"))
           )      
  )
  (princ "\n新旧标高差<")(princ bgaoy0)
  (setq x (getreal ">:")         
        y (if x x bgaoy0) bgaoy0 y
  )
  (if ss
    (progn
      (princ "\n旧,新标高分别为:")
      (repeat (sslength ss)
        (setq sn (ssname ss n) en (entget sn) n (1+ n)
        )
        (if (= (to 0) "TEXT")
          (progn
            (setq y0 (to 1) y1 y0)
            (if (eq (substr y1 1 1) "(")
              (setq y1 (substr y1 2) tr1 "(" )
              (setq tr1 nil)
            );处理带括号的标高         
            (setq y (if (or (eq y1  "%%P0.000") (eq y1 "%%p0.000")) 0.0 (atof y1))                                    
                  y (+ y bgaoy0) y (if (= y 0.0) "%%p0.000" (rtos y 2 3))
                  y (if tr1 (strcat tr1 y ")") y)               
            )
            (setq e1 (subst (cons 1 y) (assoc 1 en) en))
            (entmod e1)
          )
          (progn;处理属性块中的标高
            (setq e1 (entget (entnext (cdr (car en))))              
                  y1 (assoc 1 e1) y3 y1 y1 (cdr y1)
                  y (if (eq y1 "%%p0.000") 0.0 (distof y1)) y (+ y bgaoy0)
                  y (if (= y 0.0) "%%p0.000" (rtos y 2 3))         
                  e1 (subst (cons 1 y)(assoc 1 e1) e1)              
            )
            (entmod e1);;修改属性；
            (entmod en);;修改实体
          )
        );(if (= (to 0) "TEXT")
        (princ (strcat y1 " " y ",  "))
      );repeat
    )
  )
  (setvar "blipmode" blip)
  (command "undo" "e")
  (princ)
)
[/PHP]

gysjy

如图

kmdz

这个程序非常有用，有时候差不多的图纸还得一个一个的改，下来试试，图层要求方面应该可以修改下就不用每次都改层名了。

zh_6531394

为什么我每次只能改一个

gysjy

最初由 zh_6531394 发布
[B]为什么我每次只能改一个 [/B]

检查一下你的标高所在层是不是PUB_DIM层，如果不是，你可将程序中的“PUB_DIM”改为你的标高层。

zh_6531394

%%P0.000不行,不同的属性块名不行

gysjy

最初由 zh_6531394 发布
[B]%%P0.000不行,不同的属性块名不行 [/B]

可以将程序中的块名改为你需要的名称。%%P0.000是可以的。

zh_6531394

不行,我用的是"text21","$BG-R",楼主,麻烦您改一下

gysjy

最初由 zh_6531394 发布
[B]不行,我用的是"text21","$BG-R",楼主,麻烦您改一下 [/B]

"text21","$BG-R"是层名还是块名？

zh_6531394

块名,层名我以改成,谢谢

kongel

支持源码，谢谢了

zh_6531394

楼主,麻烦你帮忙改块名,谢谢

gysjy

将 (2 . "BGZ")(2 . "BGY")(2 . "BG")
改为 (2 . "$BG-R")(2 . "text21")(2 . "BG")

zh_6531394

楼主,还是每次只能改一个.我把改的发上来,麻烦你帮忙看,谢谢

gysjy

最初由 zh_6531394 发布
[B]楼主,还是每次只能改一个.我把改的发上来,麻烦你帮忙看,谢谢 [/B]

把你的DWG发一个上来看看。