这是我写的一个画标高的程序，大家来看看啊。

zhynt

这是对话框：

bg : dialog {
   label = "标高标注设置 <作者：张越 2000.6.12>";
     : column {
          : row {
          : boxed_column {
             label = "基准点：";
            : button {
               label = "基准点：〈";
               key = "pick";
            }
           : edit_box {
               label = "起始标高：";
               key = "ssbg";
            }
         }
         : boxed_column {
         label = "标高值：";
          fixed_width = true ;
            : toggle {
               label = "手工输入标高值";
                 key = "yn";
            }
            : edit_box {
            label = "标高值：";
            is_enabled = false;
            key = "bgz";
            }
            }
            }
            : row {
             : boxed_column {
              label = "比例：";
               fixed_width = true ;
            : edit_box {
              label = "作图比例：";
               fixed_width = true ;
              key = "scale1";
              value = "100";
            }
            : edit_box {
              label = "图纸比例：";
               fixed_width = true ;
              key = "scale2";
              value = "100";
            }
         }
            : boxed_column {
            label = "标高式样：";
          // fixed_width = true ;
            : toggle {
               label = "画出引出线";
            //    fixed_width = true ;
               key = "yt";
            }
            : toggle {
               label = "使之与基线平行";
          //fixed_width = true ;
               key = "ym";
            }
         }
        
         }
        }
         : boxed_column {
         label = "选择字型：";
            : popup_list {
              label = "选择字型：";
              key = "styl";
             }
               fixed_height = true;
            : concatenation {
                : text_part {
                    label = "当前字型：";
                    width = 10;
                 }
                 : text_part {
                   key = "csty";
                   width = 10;
                 }
            }
         }
       spacer;
      : row {
          ok_cancel;
          : button {
             label = "说明(&H)";
              fixed_width = true;
              key = "shuoming";
          }
          spacer;
      }
}
shuoming : dialog{
      label= "简要说明";
             : column {
                : button  {
                   label = "基准点";
                   key = "shuom1";
                }
                : button  {
                   label = "手工输入标高";
                   key = "shuom2";
                }
                : button  {
                   label = "作图比例";
                   key = "shuom3";
                }
                : button  {
                   label = "图纸比例";
                   key = "shuom4";
                }
                : button  {
                   label = "选择字型";
                   key = "shuom5";
                }
                : button  {
                   label = "使之与基线平行";
                   key = "shuom6";
                }
                ok_only;
             }
}
shuom1 : dialog {
      label= "简要说明";
     : boxed_column {
      label= "基准点说明";
        fixed_height = true;
        fixed_widht = true;
        : text {
           label = " 用于设置基准标高值的位置。";
        }
     }
     ok_only;
}
shuom2 : dialog {
      label= "简要说明";
     : boxed_column {
      label= "手工标高输入说明";
        fixed_height = true;
        fixed_widht = true;
        : text {
           label = " 打开时程序将提示你输入标高值。";
        }
        : text {
           label = " 有记忆功能。";
        }  
        : text {
           label = " 关闭时程序将直接画出插入点的标高。";
        }
     }
     ok_only;
}
shuom3 : dialog {
      label= "简要说明";
     : boxed_column {
      label= "作图比例说明";
        fixed_height = true;
        fixed_widht = true;
        : text {
           label = " 即你所要进行标注的大样图或立面图的比例。";
        }
     }
     ok_only;
}
shuom4 : dialog {
      label= "简要说明";
     : boxed_column {
        label= "图纸比例说明";
        fixed_height = true;
        fixed_widht = true;
        : text {
           label = " 即出图时所用的比例。";
        }
     }
     ok_only;
}
shuom5 : dialog {
label= "简要说明";
: boxed_column {
label= "选择字型说明";
fixed_height = true;
fixed_widht = true;
: text {
label = " 即画标高时所用的字型。";
}
}
ok_only;
}
shuom6 : dialog {
label= "简要说明";
: boxed_column {
label= "与基线平行说明";
fixed_height = true;
fixed_widht = true;
: text {
label = " 用于水暖作图时，将标高方向同管道。";
}
}
ok_only;
}


这是主程序：

;;;       ===============================================
;;;       |             标高自动标注软件                 |
;;;       |         版本: V4.0   作者: 张越 (99.7.9-29)  |
;;;       |         修改于2000.6                         |
;;;       ===============================================
(defun C:bg (/           dx         dy    dx1   dx2   dy1         pt    txt   txt2
             oldsty         lay   pt1   pt2   pt3         pt4   pt5   ptt
             sc1   sc2
            )
  (defun insbg ()
                                        ; (grread)
    (command "insert" "bg" pause "" "")
  )
  (setvar "CMDECHO" 0)
  (setq lay (getvar "clayer"))
  (command "color" "bylayer")
  (if (= nil (tblsearch "layer" "wz"))
    (command "layer" "m" "wz" "c" "7" "" "")
  )
  (if (= nil (tblsearch "layer" "bg"))
    (command "layer" "m" "bg" "c" "9" "" "")
  )
  (if (not ztsc)
    (progn
      (alert
        "    您还没有进行必要的设置\n工作，请先使用“sbg”命令。\n祝您工作愉快！\n\n
----------------作者：张越"
      )
      (exit)
    )
  )
  (setq sc1 (atoi tzsc))
  (setq sc2 (/ (atof ztsc) 100))
  (setq os (getvar "osmode"))
  (setvar "osmode" 547)
  (if (= ym1 "1")
    (progn
      (setq obline (car (entsel "请选择一条基准线")))
      (command "ucs" "OB" obline)
    )
  )
  (setq pt (getpoint "\n插入点: "))
  (setvar "osmode" 0)
  (setq orth (getvar "orthomode"))
  (setvar "orthomode" 0)
  (setq ang (getangle pt "\n方向 <用鼠标指取,直接回车为右上>："))
  (if (= ang nil)
    (setq ang 0.5)
  )
  (setvar "orthomode" orth)
  (if (= ssbg nil)
    (setq ssbg1 0.000)
    (setq ssbg1 (atof ssbg))
  )
  (if (= yn1 "1")
    (progn
      (prompt "\n输入标高值<")
      (prompt bgz1)
      (setq txt2 (getstring ">"))
      (if (= txt2 "")
        (setq txt2 bgz1)
        (setq bgz1 txt2)
      )
      (if (or (= txt2 "0") (= txt2 "0.000"))
        (setq txt2 "%%1290.000")
      )
    )
    (progn
      (if (= opt nil)
        (progn
          (setq opt pt)
          (setq ypt (cadr opt))
          (setq xpt (car opt))
        )
      )
      (setq dy (- (cadr pt) ypt))
      (setq txt (+ (* (/ dy (* sc1 10)) sc2) ssbg1))
      (setq txt2 (rtos txt 2 3))
      (if (or (= txt2 "0.000") (= txt2 "0"))
        (setq txt2 "%%1290.000")
      )
    )
  )
  (setq pt1 (polar pt 3.14159 (* 6 sc1)))
  (setq pt2 (polar pt 0 (* 3 sc1)))
  (setvar "clayer" "bg")
  (if (= yt1 "1")
    (command "line" pt1 pt2 "")
  )
  (if (/= sty0 nil)
    (setvar "textstyle" sty0)
  )
  (cond
    ((and (> ang 0)
          (< ang (/ pi 2))
     )
     (setq pt4 (polar pt 0.785398 (* 3.5 sc1)))
     (setq pt3 (polar pt 2.356194 (* 3.5 sc1)))
     (setq pt5 (polar pt3 0 (* 15 sc1)))
     (setq ptt (polar pt5 2.094395 (* 1.1547 sc1)))
     (setq high (* 3 sc1))
     (setvar "clayer" "wz")
     (command "text" "r" ptt high "0" txt2)
    )
    ((and (> ang 4.88691)
          (< ang 6.283185)
     )
     (setq pt4 (polar pt 5.497787 (* 3.5 sc1)))
     (setq pt3 (polar pt 3.926991 (* 3.5 sc1)))
     (setq pt5 (polar pt3 0 (* 15 sc1)))
     (setq ptt (polar pt5 4.188790 (* 1.1547 sc1)))
     (setq high (* 3 sc1))
     (setvar "clayer" "wz")
     (command "text" "tr" ptt high "0" txt2)
    )
    ((and (> ang (/ pi 2))
          (< ang pi)
     )
     (setq pt3 (polar pt 0.785398 (* 3.5 sc1)))
     (setq pt4 (polar pt 2.356194 (* 3.5 sc1)))
     (setq pt5 (polar pt3 pi (* 15 sc1)))
     (setq ptt (polar pt5 1.047198 (* 1.1547 sc1)))
     (setq high (* 3 sc1))
     (setvar "clayer" "wz")
     (command "text" ptt high "0" txt2)
    )
    ((and (> ang 3.141593)
          (< ang 4.886922)
     )
     (setq pt4 (polar pt 3.926991 (* 3.5 sc1)))
     (setq pt3 (polar pt 5.497787 (* 3.5 sc1)))
     (setq pt5 (polar pt3 pi (* 15 sc1)))
     (setq ptt (polar pt5 5.325988 (* 1.1547 sc1)))
     (setq high (* 3 sc1))
     (setvar "clayer" "wz")
     (command "text" "tl" ptt high "0" txt2)
    )
  )
  (setvar "clayer" "bg")
  (setq ww (getvar "plinewid"))
  (setvar "plinewid" 0)
  (command "pline" pt4 pt pt3 pt5 "")
  (setvar "plinewid" ww)
  (setvar "clayer" lay)
  (setvar "osmode" os)
  (IF (= ym1 "1")
    (COMMAND "UCS" "")
  )
  (princ)
)
;;;;;=========================================
;;;;;              初始值设置
;;;;;=========================================
(defun c:sbg (/ whet_next dia_id sty_zh opt osan)
  (defun style ()
    (setq n (atoi (get_tile "styl")))
    (setq sty (nth n stytab))
    (setq sty0 sty)
    (set_tile "csty" sty)
  )
(defun fdzx (/ sty1 sty2 first tab sm1 sm2)
  (setq first T)
  (setq tab '())
  (setq stytab '())
  (setq sty_zh '())
  (while (setq sty1 (tblnext "style" first)) ;搜索图中字型      　
    (if        (= first T)
      (setq first nil)
    )
    (if        (/= sty1 nil)
      (progn
        (setq tab (cons sty1 tab))
        (setq sty1 (nth 0 tab))
        (setq sty2 (dxf 2 sty1))        ;字型名称
        (setq sm1 (dxf 3 sty1))                ;所用小字体文件的名称
        (setq sm2 (dxf 4 sty1))                ;所用大字体文件的名称
        (setq stytab (cons sty2 stytab))
        (if (and sm2 (/= sm2 ""))
          (setq sty_zh (cons (strcat sty2 " : < " sm1 " , " sm2 " >") sty_zh))
          (setq sty_zh (cons (strcat sty2 " : < " sm1 " >") sty_zh))
        )
      )
    )
  )
)
  (defun bgzh ()
    (setq yn1 (get_tile "yn"))
    (if        (= yn1 "1")
      (progn
        (mode_tile "pick" 1)
        (mode_tile "ssbg" 1)
        (mode_tile "bgz" 0)
      )
      (progn
        (mode_tile "pick" 0)
        (mode_tile "ssbg" 0)
        (mode_tile "bgz" 1)
      )
    )
  )
  (defun shuo ()
    (if        (not (new_dialog "shuoming" dia_id))
      (exit)
    )
    (action_tile "shuom1" "(shuo1)")
    (action_tile "shuom2" "(shuo2)")
    (action_tile "shuom3" "(shuo3)")
    (action_tile "shuom4" "(shuo4)")
    (action_tile "shuom5" "(shuo5)")
    (action_tile "shuom6" "(shuo6)")
    (action_tile "accept" "(done_dialog 6)")
    (start_dialog)
  )
  (defun shuo1 ()
    (if        (not (new_dialog "shuom1" dia_id))
      (exit)
    )
    (action_tile "accept" "(done_dialog 6)")
    (start_dialog)
  )
  (defun shuo2 ()
    (if        (not (new_dialog "shuom2" dia_id))
      (exit)
    )
    (action_tile "accept" "(done_dialog 6)")
    (start_dialog)
  )
  (defun shuo3 ()
    (if        (not (new_dialog "shuom3" dia_id))
      (exit)
    )
    (action_tile "accept" "(done_dialog 6)")
    (start_dialog)
  )
  (defun shuo4 ()
    (if        (not (new_dialog "shuom4" dia_id))
      (exit)
    )
    (action_tile "accept" "(done_dialog 6)")
    (start_dialog)
  )
  (defun shuo5 ()
    (if        (not (new_dialog "shuom5" dia_id))
      (exit)
    )
    (action_tile "accept" "(done_dialog 6)")
    (start_dialog)
  )
  (defun shuo6 ()
    (if        (not (new_dialog "shuom6" dia_id))
      (exit)
    )
    (action_tile "accept" "(done_dialog 6)")
    (start_dialog)
  )
  (fdzx)
  (setq sty0 (getvar "textstyle"))
  (setq oldsty sty0)
  (setq whet_next 6)
  (if (and (not dia_id) (< (setq dia_id (load_dialog "bg")) 0))
    (exit)
  )
  (while (< 2 whet_next)
    (if        (not (new_dialog "bg" dia_id))
      (exit)
    )
    (if        (= ssbg nil)
      (set_tile "ssbg" "0.000")
      (set_tile "ssbg" ssbg)
    )
    (if        (= ztsc nil)
      (progn
        (set_tile "scale1" "100")
        (setq ztsc "100")
      )
      (set_tile "scale1" ztsc)
    )
    (if        (= tzsc nil)
      (progn
        (set_tile "scale2" "100")
        (setq tzsc "100")
      )
      (set_tile "scale2" tzsc)
    )
    (if        (= yn1 nil)
      (set_tile "yn" "0")
      (set_tile "yn" yn1)
    )
    (if        (= yn1 "1")
      (progn
        (mode_tile "pick" 1)
        (mode_tile "ssbg" 1)
        (mode_tile "bgz" 0)
        )
    )
    (if        (= yt1 nil)
      (set_tile "yt" "0")
      (set_tile "yt" yt1)
    )
    (if        (= ym1 nil)
      (set_tile "ym" "0")
      (set_tile "ym" ym1)
    )
    (if        (= bgz1 nil)
      (progn
        (set_tile "bgz" "0.000")
        (setq bgz1 "0.000")
      )
      (set_tile "bgz" bgz1)
    )
    (action_tile "pick" "(done_dialog 4)")
    (action_tile "ssbg" "(setq ssbg $value)")
    (action_tile "yn" "(bgzh)")
    (ACTION_TILE "yt" "(SETQ yt1 $VALUE)")
    (ACTION_TILE "ym" "(setq ym1 $VALUE)")
    (action_tile "bgz" "(setq bgz1 $value)")
    (action_tile "scale1" "(setq ztsc $value)")
    (action_tile "scale2" "(setq tzsc $value)")
    (start_list "styl")                        ;字型列表
    (mapcar 'add_list sty_zh)
    (end_list)
    (setq n (- (length stytab) (length (member sty0 stytab))))
    (set_tile "styl" (itoa n))                ;聚焦在所用字型上
    (action_tile "styl" "(style)")
    (if        (= sty nil)
      (set_tile "csty" sty0)
      (set_tile "csty" sty)
    )
    (action_tile "shuoming" "(shuo)")
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(unload_dialog dia_id)")
                                        ;(action_tile "erase" "(done_dialog 0)(setq ztsc nil)
                                        ;                     (setq tzsc nil)(setq ypt nil)(setq xpt nil)")
    (setq whet_next (start_dialog))
    (if        (/= sty nil)
      (setvar "textstyle" sty)
    )
    (if        (= whet_next 4)
      (progn
        (setq osan (getvar "osmode"))
        (setvar "osmode" 512)
        (setq opt (getpoint "\n选择基准点:"))
        (setvar "osmode" osan)
        (setq ypt (cadr opt))
        (setq xpt (car opt))
      )
    )
  )
)

vladimirputin

非常不错的代码，谢谢楼主分享啊。

lamomo

感觉很好用

zhynt

leeyeafu

程序执行到这一行出错：
(setq sty2 (dxf 2 sty1)) ;字型名称
错误原因：找不到DXF函数。
你的程序中确实找不到(defun:dxf()之类的定义人，是否你在其它文件中定义了该函数？
大致浏览了你的源程序，感觉不错。

zhynt

dxf.lsp内容如下：

(defun dxf (code elist)
  (cdr (assoc code elist))
)               

不好意思啊。

bzjustb

好东西哦，不知道有没有[U]vba[/U]的？

王咣生

如果觉得好,就改成VBA的吧!

bzjustb

我不懂vlisp，只懂点vba,哪位好心人给转化一下吧，版主有兴趣吗？

2002-ytf

5F的怎样加到1F,加进去后,appLoad "bg.lsp" command: bg, 但提示:未设比例


command: sbg 但提示:未设比例

yoyoho

感谢zhynt楼主分享程序,<谢谢!>