如何实现阵列加标高值

注册

以下是复制加标高增加标高值的源程序（感谢原作者），哪位高手能帮助改一下达到如下结果：单方向阵列加标高值，就是在画高层建筑时如果我一层标高为正负零（图中已经标出该标高），共有20层，直接阵列该标高值20次（垂直方向），则直接生成每一层的标高，谢谢！
(defun c:jbg ()
  ;(PXT_ER)
  (defun DXF (n da) (cdr (assoc n da)))
  (setq        xtblm '("osmode" "clayer" "cecolor" "orthomode" "plinewid")
        xtblz (mapcar 'getvar xtblm)
  )
  (setvar "osmode" 1) ;_捕捉端点  
  (princ "\n请选择要复制\"图层为_B标高\"的标高(退出)：")
;;;  (setq        ss (ssget ":L"
;;;                  (list (cons 8 "B标高"))
;;;           )
;;;  )
  (setq ss (ssget))
  (if ss
    (progn
      (command "undo" "be")
      (if (null bl-cb)
        (setq bl-cb 1.0)
      )
      (prompt (strcat "\n当前缩放比例:【" (rtos bl-cb 2 1) "】"))
      (initget "Bili")
      (setq p1 (getpoint "\nBili改变比例/ 基点(退出)："))
      (while (= p1 "Bili")
        (setq
          bl-cb2
           (getreal (strcat "\n请输入比例:<" (rtos bl-cb 2 1) ">")
           )
        )
        (if bl-cb2
          (setq bl-cb bl-cb2)
          (setq bl-cb bl-cb)
        )
        (prompt (strcat "\n当前缩放比例:【" (rtos bl-cb 2 1) "】"))
        (initget "Bili")
        (setq p1 (getpoint "\nBili改变比例/ 基点(退出)："))
      )
      ;;--------------------------------------------  
      (setvar "osmode" 673) ;_捕捉端点、交叉点、最近点 垂足
      (while (setq p2 (getpoint p1 "\n拷贝至 (退出): "))
        ;;-------------------------------
        ;; 返回复制后，新生成的物体ss_new
        (setq en_Last (entlast)
              ss_new  (ssadd)
        )
        (command "copy" ss "" p1 p2)
        (setq en_next (entnext en_Last))
        (while en_next
          (ssadd en_next ss_new)
          (setq en_next (entnext en_next))
        )
        ;;------------------------------

        (setq i 0)
        (repeat        (sslength ss_new)
          (setq        en   (ssname ss_new i)
                da   (entget en)
                enty (DXF 0 da)
          )
          (cond
            ;;处理：普通标高text 天正标高
            ((member enty (list "TEXT" "TCH_ELEVATION"))
             (setq txt (DXF 1 da))
             (if (or (= txt "%%p0.000")
                     (= txt "0") ;_Tch标高为 (1 . "0")
                     (and (/= (atof txt) 0)
                          (wcmatch txt "*.*")
                     )
                 )
               (progn
                 ;;--计算高差----
                 (setq d   (- (cadr p2) (cadr p1))
                       d   (* d 0.001 bl-cb)
                       num (+ (atof txt) d)
                 )
                 (setq txt-n (rtos num 2 3))
                 (if (= txt-n "0.000")
                   (setq txt-n "%%p0.000")
                 )
                 ;;-------------
                 (setq da (subst (cons 1 txt-n) (assoc 1 da) da))
                 (entmod da)
               )
             )
            )
            ;;处理：属性标高
            ((member enty (list "INSERT"))
             (setq da  (entget (entnext en))
                   txt (DXF 1 da)
             )
             ;;--计算高差----
             (setq d   (- (cadr p2) (cadr p1))
                   d   (* d 0.001 bl-cb)
                   num (+ (atof txt) d)
             )
             (setq txt-n (rtos num 2 3))
             (if (= txt-n "0.000")
               (setq txt-n "%%p0.000")
             )
             ;;-------------

             ;;============================
             ;; 替换属性文字
             (setq da (entget (entnext en)))
             (setq da (subst (cons 1 txt-n) (assoc 1 da) da))
             (entmod da)
             (entupd en)
             (entupd (entnext en))
             ;;============================
            )
          ) ;_ cond
          (setq i (1+ i))
        ) ;_end repeat
      ) ;_end while
      (command "undo" "e")
    )
  ) ;_ if ss
  (mapcar 'setvar xtblm xtblz)
  (princ)
)

ZZXXQQ

2. ;阵列标高
   
3. (defun c:arbg ()
   
4.   ;(PXT_ER)
   
5. (defun DXF (n da) (cdr (assoc n da)))
   
6. (setq xtblm '("osmode" "clayer" "cecolor" "orthomode" "plinewid")
   
7.        xtblz (mapcar 'getvar xtblm))
   
8. (setvar "osmode" 1) ;_捕捉端点  
   
9. (if  (setq s1 (entsel "\n请选择要复制"图层为_B标高"的标高(退出)：")) (progn
   
10.   (command "undo" "be")
    
11.   (if (null bl-cb) (setq bl-cb 1.0))
    
12.   (prompt (strcat "\n当前缩放比例:【" (rtos bl-cb 2 1) "】"))
    
13.   (initget "Bili")
    
14.   (setq p1 (getpoint "\nBili改变比例/ 基点(退出)："))
    
15.   (while (= (progn (initget "Bili")
    
16.                   (setq p1 (getpoint "\nBili改变比例/ 基点(退出)："))) "Bili")
    
17.    (setq bl-cb2 (getreal (strcat "\n请输入比例:<" (rtos bl-cb 2 1) ">")))
    
18.    (setq bl-cb (if bl-cb2 bl-cb2 bl-cb))
    
19.    (prompt (strcat "\n当前缩放比例:【" (rtos bl-cb 2 1) "】"))
    
20.   )
    
21. ;;--------------------------------------------  
    
22.   (setq en_Last (entlast) ss  (ssadd))
    
23.   (command "_.ARRAY" s1 "" "R")
    
24.   (if (> (getvar "CMDACTIVE") 0) (command PAUSE))
    
25. ;; 返回阵列后，新生成的物体ss
    
26.   (while (setq en_Last (entnext en_Last))
    
27.    (ssadd en_Last ss)
    
28.   )
    
29. ;;------------------------------
    
30.   (setq i 0)
    
31.   (repeat (sslength ss)
    
32.    (setq en (ssname ss i)
    
33.         da (entget en)
    
34.         enty (DXF 0 da))
    
35.    (cond ;;处理：普通标高text 天正标高
    
36.     ((member enty (list "TEXT" "TCH_ELEVATION"))
    
37.      (setq txt (DXF 1 da))
    
38.      (if (or (= txt "%%p0.000") (= txt "0") ;_Tch标高为 (1 . "0")
    
39.                (and (/= (atof txt) 0) (wcmatch txt "*.*"))
    
40.           ) (progn
    
41. ;;--计算高差----
    
42.       (setq d (* (- (cadr p2) (cadr p1)) 0.001 bl-cb)
    
43.          num (+ (atof txt) d))
    
44.       (setq txt-n (rtos num 2 3))
    
45.       (if (= txt-n "0.000") (setq txt-n "%%p0.000"))
    
46. ;;------------
    
47.       (entmod (subst (cons 1 txt-n) (assoc 1 da) da))
    
48.      ))
    
49.     )
    
50. ;;处理：属性标高
    
51.     ((member enty (list "INSERT"))
    
52.      (setq da  (entget (entnext en))
    
53.           txt (DXF 1 da))
    
54. ;;--计算高差----
    
55.      (setq d (* (- (cadr p2) (cadr p1)) 0.001 bl-cb)
    
56.            num (+ (atof txt) d))
    
57.      (setq txt-n (rtos num 2 3))
    
58.      (if (= txt-n "0.000") (setq txt-n "%%p0.000"))
    
59. ;; 替换属性文字
    
60.      (setq da (entget (entnext en)))
    
61.      (entmod (subst (cons 1 txt-n) (assoc 1 da) da))
    
62.      (entupd en)
    
63.      (entupd (entnext en))
    
64. ;;============================
    
65.     )
    
66.    ) ;_ cond
    
67.    (setq i (1+ i))
    
68.   ) ;_end repeat
    
69. )) ;_end while
    
70. (command "undo" "e")
    
71. (mapcar 'setvar xtblm xtblz)
    
72. (princ)
    
73. )
    

;阵列标高<br /> (defun c:arbg ()<br />   ;(PXT_ER)<br /> (defun DXF (n da) (cdr (assoc n da)))<br /> (setq xtblm '("osmode" "clayer" "cecolor" "orthomode" "plinewid")<br />        xtblz (mapcar 'getvar xtblm))<br /> (setvar "osmode" 1) ;_捕捉端点  <br /> (if  (setq s1 (entsel "\n请选择要复制"图层为_B标高"的标高(退出)：")) (progn<br />   (command "undo" "be")<br />   (if (null bl-cb) (setq bl-cb 1.0))<br />   (prompt (strcat "\n当前缩放比例:【" (rtos bl-cb 2 1) "】"))<br />   (initget "Bili")<br />   (setq p1 (getpoint "\nBili改变比例/ 基点(退出)："))<br />   (while (= (progn (initget "Bili")<br />                   (setq p1 (getpoint "\nBili改变比例/ 基点(退出)："))) "Bili")<br />    (setq bl-cb2 (getreal (strcat "\n请输入比例:<" (rtos bl-cb 2 1) ">")))<br />    (setq bl-cb (if bl-cb2 bl-cb2 bl-cb))<br />    (prompt (strcat "\n当前缩放比例:【" (rtos bl-cb 2 1) "】"))<br />   )<br /> ;;--------------------------------------------  <br />   (setq en_Last (entlast) ss  (ssadd))<br />   (command "_.ARRAY" s1 "" "R")<br />   (if (> (getvar "CMDACTIVE") 0) (command PAUSE))<br /> ;; 返回阵列后，新生成的物体ss<br />   (while (setq en_Last (entnext en_Last))<br />    (ssadd en_Last ss)<br />   )<br /> ;;------------------------------<br />   (setq i 0)<br />   (repeat (sslength ss)<br />    (setq en (ssname ss i)<br />         da (entget en)<br />         enty (DXF 0 da))<br />    (cond ;;处理：普通标高text 天正标高<br />     ((member enty (list "TEXT" "TCH_ELEVATION"))<br />      (setq txt (DXF 1 da))<br />      (if (or (= txt "%%p0.000") (= txt "0") ;_Tch标高为 (1 . "0")<br />                (and (/= (atof txt) 0) (wcmatch txt "*.*"))<br />           ) (progn<br /> ;;--计算高差----<br />       (setq d (* (- (cadr p2) (cadr p1)) 0.001 bl-cb)<br />          num (+ (atof txt) d))<br />       (setq txt-n (rtos num 2 3))<br />       (if (= txt-n "0.000") (setq txt-n "%%p0.000"))<br /> ;;------------<br />       (entmod (subst (cons 1 txt-n) (assoc 1 da) da))<br />      ))<br />     )<br /> ;;处理：属性标高<br />     ((member enty (list "INSERT"))<br />      (setq da  (entget (entnext en))<br />           txt (DXF 1 da))<br /> ;;--计算高差----<br />      (setq d (* (- (cadr p2) (cadr p1)) 0.001 bl-cb)<br />            num (+ (atof txt) d))<br />      (setq txt-n (rtos num 2 3))<br />      (if (= txt-n "0.000") (setq txt-n "%%p0.000"))<br /> ;; 替换属性文字<br />      (setq da (entget (entnext en))) <br />      (entmod (subst (cons 1 txt-n) (assoc 1 da) da))<br />      (entupd en)<br />      (entupd (entnext en))<br /> ;;============================<br />     )<br />    ) ;_ cond<br />    (setq i (1+ i))<br />   ) ;_end repeat<br /> )) ;_end while<br /> (command "undo" "e")<br /> (mapcar 'setvar xtblm xtblz)<br /> (princ)<br /> )<br />

edata

提个思路。
选择标高符号标准，判断标高符号类型。普通文字 属性块 天正标高。。
以此作为标准选择集，指定符号基点，确定楼层数，每层高度，地下多少层。
确定0.00标高（或者在第一步就是0.00标高。）
repeat 楼层数，根据基点 每层高度 计算复制点，并修改标高文字
完成。

xyp1964

xyp1964

注册

ZZXXQQ 发表于 2014-6-17 08:31

CAD2010输入命令arbg没有反应呢