这是我写的一个画标高的程序，大家来看看啊。
这是对话框：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))
)
)
)
) 非常不错的代码，谢谢楼主分享啊。 感觉很好用
不会吧，我用得好好的呀。可能是你的路径不通
有个问题
程序执行到这一行出错：(setq sty2 (dxf 2 sty1)) ;字型名称
错误原因：找不到DXF函数。
你的程序中确实找不到(defun:dxf()之类的定义人，是否你在其它文件中定义了该函数？
大致浏览了你的源程序，感觉不错。
是的是的，谢谢你，我现在加上去。
dxf.lsp内容如下：(defun dxf (code elist)
(cdr (assoc code elist))
)
不好意思啊。
[建议]好东西哦，不知道有没有vba的？
好东西哦，不知道有没有<FONT color=#ff0033 size=5>vba</FONT>的？如果觉得好,就改成VBA的吧
如果觉得好,就改成VBA的吧! 我不懂vlisp，只懂点vba,哪位好心人给转化一下吧，版主有兴趣吗？ 5F的怎样加到1F,加进去后,appLoad "bg.lsp" command: bg, 但提示:未设比例command: sbg 但提示:未设比例 感谢zhynt楼主分享程序,<谢谢!>