[求助]：刚刚学编程，只会一点点拷贝

pipi002004

这个lisp是我自己改的，借用了几天前xyp1964大侠的一些东西，不过还不完美
有人帮我改一下好么，因为我不想用多行文本，哪个大哥帮我用改一下，改成用单行文本的，可以么？先谢谢了！拷贝的部分可能不太好，有些代码可能没用哦，单行文本样式用pipi_标高
(defun c:bg ( / sc scab)
  (if (= scab nil)
    (setq scab 1.0)
  )
  (setq sc (getreal (strcat "\n输入比例 <" (rtos scab 2 0) ">:")))
  (if (= sc nil)
    (setq sc scab)
  )
  (setq scab sc)                ;标注层高或高度
  (setvar "dimzin" 3)
  (setq lay (getvar "clayer"))
  (command "color" "bylayer")
  (command "layer" "m" "pipi_标高" "c" "94" "" "")
  (if (or (= nil (tblsearch "style" "pipi_标高"))
          (/= (cdr (assoc 40 (tblsearch "style" "pipi_标高"))) 0)
      )
    (command "STYLE" "pipi_标高" "Tssdeng" "0" "0.75" "0" "n" "n" "n")
  )
  (setq p1 (getpoint "\n请设定标高基准点:"))
  (setq key1 nil)
  (initget "y n")
  (setq key1 (getkword "\n标注是左面吗?<y-左面,n-右面>(/y)"))
  (if (= key1 nil)
    (setq key1 "y")
  )
  (setvar "osmode" 0)
  (setq        d1 (* 3 sc)
        d2 (* 3 sc)
        d3 (* 16 sc)
        d4 (* 0.8 sc)
        h  (* 3 sc)
  )
  (setq key 1)
  (setq txt "%%P0.000")
  (if (= key1 "y")
    (drawbgz p1 d1 d2 d3 d4 h txt)
    (drawbgy p1 d1 d2 d3 d4 h txt)
  )


  (setq p0 p1)
  (while (/= key nil)
    (setvar "osmode" 191)
    (if        (/= (setq pt (getpoint "\n请点标高的点:")) nil)
      (progn
        (setq ht (- (nth 1 pt) (nth 1 p0)))
        (setq ht (/ ht (* 10.000 sc)))
        (setq txt (rtos ht 2 3))
        (setq txt (atof txt))
        (setq txt (rtos txt 2 3))
        (setq p1 pt)
        (setvar "osmode" 0)
        (if (= key1 "y")
          (drawbgz p1 d1 d2 d3 d4 h txt)
          (drawbgy p1 d1 d2 d3 d4 h txt)
        )
      )
      (setq key nil)
    )
  )
  (setvar "osmode" 191)
)

(defun drawbgy (p1 d1 d2 d3 d4 h txt)
  (command "layer" "m" "pipi_标高" "c" "94" "" "")
  (setq lay (getvar "clayer"))
  (setq p2 (list (+ (nth 0 p1) d1) (nth 1 p1)))
  (setq p3 (list (+ (nth 0 p2) d1) (nth 1 p2)))
  (setq p4 (list (- (nth 0 p2) d2) (+ (nth 1 p2) d2)))
  (setq p5 (list (+ (nth 0 p4) (* d2 2)) (nth 1 p4)))
  (setq p6 (list (+ (nth 0 p4) d3) (nth 1 p4)))
  (command "line" p1 p3 "")
  (command "line" p2 p4 "")
  (command "line" p2 p5 "")
  (command "line" p4 p6 "")
;;;设置文字的插入点
  (setq bgpt (list (+ (nth 0 p5) d4) (+ (nth 1 p5) (+ d4 h))))
  (command "layer" "m" "pipi_文字" "c" "white" "" "")
  (command "text" "s" "pipi_标高" ptt high "0" txt1)
  (setq lay (getvar "clayer"))
  (setq he (list h lay d3))
  (dd_creatext txt bgpt he)
)
(defun drawbgz (p1 d1 d2 d3 d4 h txt)
  (command "layer" "m" "pipi_标高" "c" "94" "" "")
  (setq lay (getvar "clayer"))
  (setq p2 (list (- (nth 0 p1) d1) (nth 1 p1)))
  (setq p3 (list (- (nth 0 p2) d1) (nth 1 p2)))
  (setq p4 (list (+ (nth 0 p2) d2) (+ (nth 1 p2) d2)))
  (setq p5 (list (- (nth 0 p4) (* d2 2)) (nth 1 p4)))
  (setq p6 (list (- (nth 0 p4) d3) (nth 1 p4)))
  (command "line" p1 p3 "")
  (command "line" p2 p4 "")
  (command "line" p2 p5 "")
  (command "line" p4 p6 "")
;;;设置文字的插入点
  (setq bgpt (list (+ (nth 0 p6) d4) (+ (nth 1 p6) (+ d4 h))))
  (command "layer" "m" "pipi_文字" "c" "white" "" "")
  (command "text" "s" "pipi_标高" ptt high "0" txt1)
  (setq lay (getvar "clayer"))
  (setq he (list h lay d3))
  (dd_creatext txt bgpt he)
)

(defun dd_creatext (TXT P lst / otxtlst txtlst h LAYER w ts)
                                        ;写文字程序
  (SETQ H (CAR LST))
  (SETQ LST (CDR LST))
  (SETQ LAYER (CAR LST))
  (SETQ LST (CDR LST))
  (SETQ W (CAR LST))
  (SETQ LST (CDR LST))
  (SETQ TS (CAR LST))
  (SETQ LST (CDR LST))
  (IF (NULL H)
    (SETQ H (getvar "TEXTSIZE"))
  )
  (IF (NULL LAYER)
    (setq layer (getvar "clayer"))
  )
  (IF (NULL TS)
    (SETQ TS (getvar "TEXTSTYLE"))
  )
  (IF (NULL w)
    (SETQ w (cdr (assoc 41 (entget (tblobjname "style" ts)))))
  )
  (setq        otxtlst        (list '(0 . "MTEXT")
                      '(100
                        .
                        "AcDbEntity"
                       )
                      '(11 0.0 0.0 0.0)
                      '(50 . 0.0)
                      '(51 . 0.0)
                      '(67 . 0)
                      '(71 . 7)
                      '(72 . 0)
                      '(73 . 0)
                      '(100
                        .
                        "AcDbMText"
                       )
                      '(210
                        0.0
                        0.0
                        1.0
                       )
                )
  )
  (setq        txtlst (append oTXTlst
                       (list (cons 10 P)
                             (cons 8 layer)
                             (cons 40 h)
                             (cons 1 txt)
                             (CONS 7 TS)
                             (cons 41 w)
                       )
               )
  )
  (if (entmake txtlst)
    (entlast)
  )
)

附带：这个程序的原程序
(defun c:bg ()                                ;标注层高或高度
  (setvar "dimzin" 3)
  (setq p1 (getpoint "\n请设定标高基准点:"))
  (setq key1 nil)
  (initget "y n")
  (setq key1 (getkword "\n标注是左面吗?<y-左面,n-右面>(/y)"))
  (if (= key1 nil)
    (setq key1 "y")
  )
  (setvar "osmode" 0)
  (setq        d1 150
        d2 120
        d3 1000
        d4 50
        h  200.0
  )
  (setq key 1)
  (setq txt "%%P0.000")
  (if (= key1 "y")
    (drawbgz p1 d1 d2 d3 d4 h txt)
    (drawbgy p1 d1 d2 d3 d4 h txt)
  )


  (setq p0 p1)
  (while (/= key nil)
    (setvar "osmode" 687)
    (if        (/= (setq pt (getpoint "\n请点标高的点:")) nil)
      (progn
        (setq ht (- (nth 1 pt) (nth 1 p0)))
        (setq ht (/ ht 1000.000))
        (setq txt (rtos ht 2 3))
        (setq txt (atof txt))
        (setq txt (rtos txt 2 3))
        (setq p1 pt)
        (setvar "osmode" 0)
        (if (= key1 "y")
          (drawbgz p1 d1 d2 d3 d4 h txt)
          (drawbgy p1 d1 d2 d3 d4 h txt)
        )
      )
      (setq key nil)
    )
  )
  (setvar "osmode" 687)
)

(defun drawbgy (p1 d1 d2 d3 d4 h txt)
  (setq p2 (list (+ (nth 0 p1) d1) (nth 1 p1)))
  (setq p3 (list (+ (nth 0 p2) d1) (nth 1 p2)))
  (setq p4 (list (- (nth 0 p2) d2) (+ (nth 1 p2) d2)))
  (setq p5 (list (+ (nth 0 p4) (* d2 2)) (nth 1 p4)))
  (setq p6 (list (+ (nth 0 p4) d3) (nth 1 p4)))
  (command "line" p1 p3 "")
  (command "line" p2 p4 "")
  (command "line" p2 p5 "")
  (command "line" p4 p6 "")
;;;设置文字的插入点
  (setq bgpt (list (+ (nth 0 p4) d4) (+ (nth 1 p4) (+ d4 h))))
  (setq lay (getvar "clayer"))
  (setq he (list h lay d3))
  (dd_creatext txt bgpt he)
)
(defun drawbgz (p1 d1 d2 d3 d4 h txt)
  (setq p2 (list (- (nth 0 p1) d1) (nth 1 p1)))
  (setq p3 (list (- (nth 0 p2) d1) (nth 1 p2)))
  (setq p4 (list (+ (nth 0 p2) d2) (+ (nth 1 p2) d2)))
  (setq p5 (list (- (nth 0 p4) (* d2 2)) (nth 1 p4)))
  (setq p6 (list (- (nth 0 p4) d3) (nth 1 p4)))
  (command "line" p1 p3 "")
  (command "line" p2 p4 "")
  (command "line" p2 p5 "")
  (command "line" p4 p6 "")
;;;设置文字的插入点
  (setq bgpt (list (+ (nth 0 p6) d4) (+ (nth 1 p6) (+ d4 h))))
  (setq lay (getvar "clayer"))
  (setq he (list h lay d3))
  (dd_creatext txt bgpt he)
)

(defun dd_creatext (TXT P lst / otxtlst txtlst h LAYER w ts)
                                        ;写文字程序
  (SETQ H (CAR LST))
  (SETQ LST (CDR LST))
  (SETQ LAYER (CAR LST))
  (SETQ LST (CDR LST))
  (SETQ W (CAR LST))
  (SETQ LST (CDR LST))
  (SETQ TS (CAR LST))
  (SETQ LST (CDR LST))
  (IF (NULL H)
    (SETQ H (getvar "TEXTSIZE"))
  )
  (IF (NULL LAYER)
    (setq layer (getvar "clayer"))
  )
  (IF (NULL TS)
    (SETQ TS (getvar "TEXTSTYLE"))
  )
  (IF (NULL w)
    (SETQ w (cdr (assoc 41 (entget (tblobjname "style" ts)))))
  )
  (setq        otxtlst        (list '(0 . "MTEXT")
                      '(100
                        .
                        "AcDbEntity"
                       )
                      '(11 0.0 0.0 0.0)
                      '(50 . 0.0)
                      '(51 . 0.0)
                      '(67 . 0)
                      '(71 . 7)
                      '(72 . 0)
                      '(73 . 0)
                      '(100
                        .
                        "AcDbMText"
                       )
                      '(210
                        0.0
                        0.0
                        1.0
                       )
                )
  )
  (setq        txtlst (append oTXTlst
                       (list (cons 10 P)
                             (cons 8 layer)
                             (cons 40 h)
                             (cons 1 txt)
                             (CONS 7 TS)
                             (cons 41 w)
                       )
               )
  )
  (if (entmake txtlst)
    (entlast)
  )
)

;;;
————————————————————————————————
尽管不怎么好，但是我想我尽力了，我只能改这么多了