[LISP程序]：非常实用的标高绘制程序

li_seashore

; ===============================================================================
;     钢 结 构 工 具 箱 v8.1                    作者：李海斌  日期：2004-08-01
; ===============================================================================
;BG——需要把所要标注的图线的0.000标高放到图形的(0,0)点，才能用默认文字，否则手工输入。
;XG——以某一点为参考点绘制标高，可连续绘制标高，文字自动生成。
;可自动缩放，以dimscale为参考变量.
;***  
(defun c:bg (/ olderr pt1 pt2 pt3 text a b s m y len old olddim )
  (setq olderr *error* *error* user_err)
  (setq old (getvar "osmode"))
  (princ "\n绝对标高")
  (initget 1)
  (setq s (getvar "DIMSCALE"))
  (setvar "osmode" 801)
  (setq pt1 (getpoint "\n标注位置:"))
  (setvar "osmode" 0)
  (setq pt3 (getpoint pt1"\n输出位置:"))
  (setq y (/ (cadr pt1) 1000))
  (if (not (setq text (getdist "\n标高文字<>:")))
      (setq text y)
  )
  (setq a (* s 3)
        b (* s 14.5)
        c (* s 4)
        pt2 (list (car pt3) (cadr pt1))
        len (distance pt1 pt2)
        m (+ len a)
  )
  (setq olddim (getvar "DIMZIN"))
  (setvar "DIMZIN" 1)
  (command ".-layer" "s" "尺寸" ""
           ".pline" pt1 "w" "0" "0" (polar pt1 (angle pt1 pt2) m) ""
           ".pline" (list (+ (car pt2) a) (+ (cadr pt2) a)) "w" "0" "0" pt2
                    (list (- (car pt2) a) (+ (cadr pt2) a))
                    (list (+ (car pt2) b) (+ (cadr pt2) a)) ""
           ".text" "j" "bl" (list (+ (car pt2) a) (+ (cadr pt2) c)) a "0" (rtos text 2 3)
           ".-layer" "s" "粗实线" ""
  )
  (setvar "DIMZIN" olddim)
  (setvar "osmode" old)
  (if olderr (setq *error* olderr))
  (princ)
);defun
;**********
(defun c:xg (/ pt1 pt2 pt3 aa bb cc a b ss m y len old olddim )
  (setq olderr *error* *error* user_err)
  (setq old (getvar "osmode"))
  (princ "\n相对标高")
  (setvar "osmode" 549)
  (setq pt1 (getpoint "\n基点:"))
  (if (not (setq aa (getdist "\n基点标高<±0.000>:")))
      (setq aa 0)
  )
  (initget 1)
  (setq ss (getvar "DIMSCALE")
        bb (* aa 1000)
  )
  (while (/= nil (setq pt2 (getpoint "\n标注位置:")))
         (setq cc (/ (+ (- (cadr pt2) (cadr pt1)) bb) 1000))
         (setvar "osmode" 0)
         (setq y (/ (cadr pt1) 1000))
         (setq a (* ss 3)
               b (* ss 14.5)
               c (* ss 4)
         )
         (setq pt3 (list (car pt1) (cadr pt2))
               len (distance pt2 pt3)
               m (+ len a)
         )
         (setq olddim (getvar "DIMZIN"))
         (setvar "DIMZIN" 1)
         (command ".-layer" "s" "尺寸" ""
                  ".pline" pt2 "w" "0" "0" (polar pt2 (angle pt2 pt3) m) ""
                  ".pline" (list (+ (car pt3) a) (+ (cadr pt3) a)) "w" "0" "0" pt3
                           (list (- (car pt3) a) (+ (cadr pt3) a))
                           (list (+ (car pt3) b) (+ (cadr pt3) a)) ""
                  ".text" "j" "bl" (list (+ (car pt3) a) (+ (cadr pt3) c)) a "0" (rtos cc 2 3)
                  ".-layer" "s" "粗实线" ""
         )
         (setvar "DIMZIN" olddim)
         (setvar "osmode" 801)
  )
  (setvar "osmode" old)
  (if olderr (setq *error* olderr))
  (princ)
);defun

xmchy

不太好用,能不能修改为任意另设(0,0))在图纸的立面0.000处设设置,而不改变ucs的原点,字体高度为300,且只是在标的三角形符号处只要点一下就可以了,(象天正的那样)谢谢!

li809

同意2楼楼主的看法和建议