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

zh_6531394

DWG发,上来,谢谢

gysjy

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

[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  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 . "$BG-R")(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]

zh_6531394

太谢谢楼主,都解决了,但%%p0.000还不行

gysjy

最初由 zh_6531394 发布
[B]都解决了,但%%p0.000还不行 [/B]

[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  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 . "$BG-R")(2 . "BG")(2 . "BGZ")(-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")(eq y1 "±0.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 (or (eq y1  "%%P0.000")(eq y1 "%%p0.000")(eq y1 "±0.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]

zh_6531394

全解决了,楼主水平太高了,谢谢

fl202

楼主你好！有些地方没有看懂，你的lisp怎么没有注释啊？
还有一个问题？你是如何得到属性块的的信息，以及应该如果修改属性块的内容，比如将一个圆和其中的字PI0203做成属性块，如何修改他的文字内容，并将圆剔除出选择集呢？

qddlm

谢谢，实用

gysjy

最初由 fl202 发布
[B]楼主你好！有些地方没有看懂，
你是如何得到属性块的的信息，以及应该如果修改属性块的内容，比如将一个圆和其中的字PI0203做成属性块，如何修改他的文字内容，并将圆剔除出... [/B]

提取属性：

2. 
   
3.   [FONT=courier new]
   
4. 
   
5.         (setq sn (entsel "\n点取物体:")  sn (car sn) en (entget sn))
   
6.         (setq e1  (entget (entnext (cdr (car en))))
   
7.               tr0 (cdr (assoc 1 e1))
   
8.         );;提取属性
   
9. 
   
10.   [/FONT]
    

<br />   [FONT=courier new]<br /> <br />         (setq sn (entsel "\n点取物体:")  sn (car sn) en (entget sn))<br />         (setq e1  (entget (entnext (cdr (car en))))<br />               tr0 (cdr (assoc 1 e1)) <br />         );;提取属性<br /> <br />   [/FONT]<br />

修改属性：

2. 
   
3.   [FONT=courier new]
   
4.   (setq tr (getstring "\n输入新属性：")
   
5.         e1 (subst (cons 1 tr) (assoc 1 e1) e1)
   
6.   )
   
7.   (entmod e1)(entmod en)
   
8.   [/FONT]
   

<br />   [FONT=courier new]<br />   (setq tr (getstring "\n输入新属性：")<br />         e1 (subst (cons 1 tr) (assoc 1 e1) e1)<br />   )<br />   (entmod e1)(entmod en)<br />   [/FONT]<br />

zhongyang730

好东西，找了很久，终于找到了，谢谢了

edenm

这个程序非常有用，有时候差不多的图纸还得一个一个的改，下来试试

176489156

知道 知道怎么用了

zhuxiaoming

佩服楼主，好想加楼主的QQ，交个朋友什么的

gysjy

谢谢。我有一个qq号，但久已不用。如有什么问题，可发Email，gysjy0@163.com。

nevsayno

看看    呵呵呵

gdp_1983

加载了，但在使用时找不到对象，不知道程序对标高有什么要求，我的标高是自己画的