如何实现阵列加标高值
以下是复制加标高增加标高值的源程序（感谢原作者），哪位高手能帮助改一下达到如下结果：单方向阵列加标高值，就是在画高层建筑时如果我一层标高为正负零（图中已经标出该标高），共有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)
)
;阵列标高
(defun c:arbg ()
;(PXT_ER)
(defun DXF (n da) (cdr (assoc n da)))
(setq xtblm '("osmode" "clayer" "cecolor" "orthomode" "plinewid")
xtblz (mapcar 'getvar xtblm))
(setvar "osmode" 1) ;_捕捉端点
(if(setq s1 (entsel "\n请选择要复制\"图层为_B标高\"的标高(退出)：")) (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 (= (progn (initget "Bili")
(setq p1 (getpoint "\nBili改变比例/ 基点(退出)："))) "Bili")
(setq bl-cb2 (getreal (strcat "\n请输入比例:<" (rtos bl-cb 2 1) ">")))
(setq bl-cb (if bl-cb2 bl-cb2 bl-cb))
(prompt (strcat "\n当前缩放比例:【" (rtos bl-cb 2 1) "】"))
)
;;--------------------------------------------
(setq en_Last (entlast) ss(ssadd))
(command "_.ARRAY" s1 "" "R")
(if (> (getvar "CMDACTIVE") 0) (command PAUSE))
;; 返回阵列后，新生成的物体ss
(while (setq en_Last (entnext en_Last))
(ssadd en_Last ss)
)
;;------------------------------
(setq i 0)
(repeat (sslength ss)
(setq en (ssname ss 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)) 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"))
;;------------
(entmod (subst (cons 1 txt-n) (assoc 1 da) da))
))
)
;;处理：属性标高
((member enty (list "INSERT"))
(setq da(entget (entnext en))
txt (DXF 1 da))
;;--计算高差----
(setq d (* (- (cadr p2) (cadr p1)) 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)))
(entmod (subst (cons 1 txt-n) (assoc 1 da) da))
(entupd en)
(entupd (entnext en))
;;============================
)
) ;_ cond
(setq i (1+ i))
) ;_end repeat
)) ;_end while
(command "undo" "e")
(mapcar 'setvar xtblm xtblz)
(princ)
)
提个思路。
选择标高符号标准，判断标高符号类型。普通文字 属性块 天正标高。。
以此作为标准选择集，指定符号基点，确定楼层数，每层高度，地下多少层。
确定0.00标高（或者在第一步就是0.00标高。）
repeat 楼层数，根据基点 每层高度 计算复制点，并修改标高文字
完成。
ZZXXQQ 发表于 2014-6-17 08:31
CAD2010输入命令arbg没有反应呢
页:
[1]