zbbz的lisp_学习LISP语言的体会
自己從事的工作關系，利用autoCAD軟件已經很多年了。
有時候，遇到一些很機械很機械的工作，總想著能不能用程序來幫幫忙。
于是，有一天就開始接觸Lisp，翻翻相關的參考書，再看看別人的實例，
漸漸地，居然慢慢地就覺得開始有點上手。
之后，開始編寫一些簡單的功能，同時，不斷的翻閱參考書，
了解其中的條理，熟悉了Liap語言的諸多函數命令。
到了一定地步，又有更野心的想法——編一個超大的程序！
一邊摸索一邊在努力，一個星期一個月過去，利用閑暇之余，
居然把它弄出來。那一下，真正體會到的其中的樂趣。
挑戰自我，還要有點野心，再加上不懈的追求。
下面是本人的編寫的一個“坐標標注”的例子，本文只是作為一個引子，希望有相同愛好的人能夠互相溝通，互相促進。在工作中遇到種種繁瑣之事，不妨考慮采用程序來幫忙，提高自己的工作效率，從中把自己解脫出來。
坐標標注選項界面定制
zbbzsz_dlg : dialog {label = "坐標標注設置編輯框";
: boxed_column {label = "標注點XYZ顯示效果";width = 45;
: row {
: text {label = "";}
: text {label = "X";}
: text {label = "Y";}
: text {label = "Z";}
}
: row {
: edit_box {label = "前綴:";key = "xq";}
: edit_box {key = "yq";}
: edit_box {key = "zq";}
}
: row {
: popup_list {label = "精度";key = "xz";list="0\n0.0\n0.00\n0.000\n0.0000\n0.00000\n0.000000";}
: popup_list {label = "";key = "yz";list="0\n0.0\n0.00\n0.000\n0.0000\n0.00000\n0.000000";}
: popup_list {label = "";key = "zz";list="0\n0.0\n0.00\n0.000\n0.0000\n0.00000\n0.000000";}
}
: row {
: edit_box {label = "后綴:";key = "xh";}
: edit_box {key = "yh";}
: edit_box {key = "zh";}
}
: row {
: edit_box {label = "比例:";key = "xbl";}
: edit_box {key = "ybl";}
: edit_box {key = "zbl";}
}
}
: row {
: boxed_column {label = "文字描述";fixed_width = true;
: row {
: button {key = "pickGD";fixed_width = true; label = "高度";}
: edit_box {label = "";key = "zg";width = 4;}
//: text {label = " ";}
}
: row {
: button {key = "pickBL";fixed_width = true; label = "寬度比例";}
: edit_box {label = "";key = "gkb";width = 4;fixed_width = true;}
//: text {label = " ";}
}
: row {
: button {key = "pickpj";fixed_width = true; label = "偏距";}
: edit_box {label = "";key = "pj";}
//: text {label = " ";}
}
: row {
: button {key = "pickfx";fixed_width = true; label = "方向";}
: edit_box {label = "";key = "fx";width = 6;fixed_width = true;}
: text {label = "度";}
}
}
spacer_1;
:column {
spacer;
: toggle {label = "顯示高程";key = "gckg";}
: toggle {label = "顯示前綴和后綴";key = "qzhz";}
: toggle {label = "指定標注位置";key = "bzwz";}
: toggle {label = "標注方向同引出方向";key = "bzfx";}
spacer;
}
}
ok_cancel;
errtile;
}
;;;該程序功能:用于坐標點的坐標標注
;;;改進前面版本的功能有
;;;1.可以指定或不指定標注位置進行標注
;;;2.可以連續進行標注,同時允許定義'字高''字寬比''方向''高程開關''前綴開關''退一步'
;;;
(defun biaozhu-a ($in / p1 p2 p3 m a old_aunits old_ORTHOMODE plw oldos
str
qianzhui
textH width_f definep biaozhuweizhi sw_h
;前綴qz 后綴hz 精度jd
xqz yqz hqz xhz yhz hhz xjd yjd hjd
;XYZ的例
xbl ybl zbl
;偏距defaultPJ 方向defaultFX
defaultPJ defaultFX
savefile biaozhuxuanxiang
*merrmsg* write_t style1 mod_style select1
)
(If (setq a (findfile "ME_TOOL.mnu"))
(setq savefile (strcat (substr a 1 (- (strlen a) 11)) "坐標標注.def"))
(setq savefile "坐標標注.def")
)
(defun *merrmsg* (msg)
(princ msg)
(setq *error* m:err m:err nil)
(setvar "osmode" oldos)
(setvar "plinewid" plw)
(setvar "aunits" old_aunits)
(setvar "ORTHOMODE" old_ORTHOMODE)
(command "undo" "end")
(setvar "CMDECHO" 1)
(princ)
)
(defun ZWX::pickPJorFX (doMode oldValue / a b entg exi)
(cond
((= 0 doMode)
(if (setq a (getdist "\n輸入文字的偏距:"))
(setq a (abs a))
)
)
((= 1 doMode)
(if (setq a (getangle "\n輸入文字的方向:"))
(setq a (/ (* 180 a) pi))
)
)
((> 4 doMode)
(setq exi nil)
(while (not exi)
(if (setq a (entsel "\n選擇文字:"))
;(progn
(if (= "TEXT" (strcase (cdr (assoc 0 (setq entg (entget (car a)))))))
(setq a (cdr (assoc (if (= 2 doMode) 40 41) entg)) exi t)
)
;)
(setq exi t)
)
)
)
)
(if a a oldValue)
)
(defun biaozhuxuanxiang ( / dcl_id xqz1 xjd1 xhz1 yqz1 yjd1 yhz1 hqz1 hjd1 hhz1
textH1 width_f1 pj1 fx1 qzhz
definep1 biaozhuweizhi1 sw_h1
doWhile
)
(setq xqz1 xqz xjd1 xjd xhz1 xhz
yqz1 yqz yjd1 yjd yhz1 yhz
hqz1 hqz hjd1 hjd hhz1 hhz
textH1 textH width_f1 width_f sw_h1 sw_h
pj1 defaultPJ fx1 defaultFX
definep1 definep biaozhuweizhi1 biaozhuweizhi
qzhz qianzhui
doWhile 2
)
(if (not (setq dcl_id (load_dialog "坐標標注.dcl")))(exit))
(while (< 1 doWhile)
(if (not (new_dialog "zbbzsz_dlg" dcl_id))(exit))
(set_tile "xq" xqz)
(set_tile "xz" (itoa xjd))
(set_tile "xh" xhz)
(set_tile "yq" yqz)
(set_tile "yz" (itoa yjd))
(set_tile "yh" yhz)
(set_tile "zq" hqz)
(set_tile "zz" (itoa hjd))
(set_tile "zh" hhz)
(set_tile "zg" (rtos textH 2))
(set_tile "gkb" (rtos width_f 2))
(set_tile "pj" (rtos defaultPJ 2))
(set_tile "fx" (rtos defaultFX 2))
(set_tile "gckg" (if sw_h "1" "0"))
(set_tile "qzhz" (if qianzhui "1" "0"))
(set_tile "bzwz" (if definep "1" "0"))
(set_tile "bzfx" (if biaozhuweizhi "1" "0"))
(set_tile "xbl" (rtos xbl 2))
(set_tile "ybl" (rtos ybl 2))
(set_tile "zbl" (rtos zbl 2))
(action_tile "xq"????? "(setq xqz (get_tile $key))")
(action_tile "xz"????? "(setq xjd (atoi (get_tile $key)))")
(action_tile "xh"????? "(setq xhz (get_tile $key))")
(action_tile "yq"????? "(setq yqz (get_tile $key))")
(action_tile "yz"????? "(setq yjd (atoi (get_tile $key)))")
(action_tile "yh"????? "(setq yhz (get_tile $key))")
(action_tile "zq"????? "(setq hqz (get_tile $key))")
(action_tile "zz"????? "(setq hjd (atoi (get_tile $key)))")
(action_tile "zh"????? "(setq hhz (get_tile $key))")
(action_tile "zg"????? "(setq textH (atof (get_tile $key)))")
(action_tile "gkb"???? "(setq width_f (atof (get_tile $key)))")
(action_tile "gckg"??? "(setq sw_h (if (= 1 (atoi (get_tile $key))) t nil))")
(action_tile "qzhz"??? "(setq qianzhui (if (= 1 (atoi (get_tile $key))) t nil))")
(action_tile "bzwz"??? "(setq definep (if (= 1 (atoi (get_tile $key))) t nil))")? ; p2 nil
(action_tile "bzfx"??? "(setq biaozhuweizhi (if (= 1 (atoi (get_tile $key))) t nil))")? ; p3 nil
(action_tile "pj"????? "(setq defaultPJ (atof (get_tile $key)))")
(action_tile "fx"????? "(setq defaultFX (atof (get_tile $key)))")
(action_tile "xbl"???? "(setq xbl (atof (get_tile $key)))")
(action_tile "ybl"???? "(setq ybl (atof (get_tile $key)))")
(action_tile "zbl"???? "(setq zbl (atof (get_tile $key)))")
(action_tile "pickpj"? "(done_dialog 2)")
(action_tile "pickfx"? "(done_dialog 3)")
(action_tile "pickGD"? "(done_dialog 4)")
(action_tile "pickBL"? "(done_dialog 5)")
(action_tile "accept"? "(done_dialog 1)")
(action_tile "cencel"? "(done_dialog 0)")
(setq doWhile (start_dialog))
(cond
((= 1 doWhile)
(if (> 0 defaultPJ)(setq defaultPJ 7.5))
(if (> 0 xbl)(setq xbl 1))
(if (> 0 ybl)(setq ybl 1))
(if (> 0 zbl)(setq zbl 1))
(select1 "ALL")(cover-def nil)
)
((= 0 doWhile)
(setq xqz xqz1 xjd xjd1 xhz xhz1
yqz yqz1 yjd yjd1 yhz yhz1
hqz hqz1 hjd hjd1 hhz hhz1
textH textH1 width_f width_f1 sw_h sw_h1
definep1 definep biaozhuweizhi1 biaozhuweizhi
defaultPJ pj1 defaultFX fx1 qianzhui qzhz
)
)
((= 2 doWhile)(setq defaultPJ (ZWX::pickPJorFX 0 defaultPJ)))
((= 3 doWhile)(setq defaultFX (ZWX::pickPJorFX 1 defaultFX)))
((= 4 doWhile)(setq textH (ZWX::pickPJorFX 2 textH)));
((= 5 doWhile)(setq width_f (ZWX::pickPJorFX 3 width_f)))
)
)
)
(defun read-def (headlist / $a $b $c $d $l $exit)
(if (setq $a (open savefile "r"))(progn
(while (and (not $exit) (setq $b (read-line $a)) $b (/= "" $b))
(if (/= (substr $b 1 2) "//")(progn
(setq $b (fg $b '("====") nil) $b (subst (strcase (car $b)) (car $b) $b)) ;改為大寫
(if (not headlist)
(setq $l (cons $b $l))
(progn
(if (member (car $b) headlist)(setq $l (cons $b $l)))
(if (and $l (= (length $l) (length headlist)))(setq $exit t))
)
)
))
)(setq $l (reverse $l))
(close $a)
)) ;(if (setq $a (open dat_filename
(setq textH (cadr (assoc "TEXTH" $l))
width_f (cadr (assoc "WIDTH_F" $l))
sw_h (cadr (assoc "SW_H" $l))
definep (cadr (assoc "DEFINEP" $l))
biaozhuweizhi (cadr (assoc "BIAOZHUWEIZHI" $l))
qianzhui (cadr (assoc "QIANZHUI" $l))
xqz (cadr (assoc "XQZ" $l))
yqz (cadr (assoc "YQZ" $l))
hqz (cadr (assoc "HQZ" $l))
xhz (cadr (assoc "XHZ" $l))
yhz (cadr (assoc "YHZ" $l))
hhz (cadr (assoc "HHZ" $l))
xjd (cadr (assoc "XJD" $l))
yjd (cadr (assoc "YJD" $l))
hjd (cadr (assoc "HJD" $l))
defaultPJ (cadr (assoc "DEFAULTPJ" $l))
defaultFX (cadr (assoc "DEFAULTFX" $l))
xbl (cadr (assoc "XBL" $l))
ybl (cadr (assoc "YBL" $l))
zbl (cadr (assoc "ZBL" $l))
)
(setq width_f (if (or (not width_f) (>= 0 (atof width_f))) 1 (atof width_f))
textH (if (or (not textH) (>= 0 (atof textH))) 1 (atof textH))
sw_h (if (and sw_h (= "T" (strcase sw_h))) t nil)
definep (if (and definep (= "T" (strcase definep))) t nil)
biaozhuweizhi (if (and biaozhuweizhi (= "T" (strcase biaozhuweizhi))) t nil)
qianzhui (if (and qianzhui (= "T" (strcase qianzhui))) t nil)
xbl (if (or (not xbl) (>= 0 (atof xbl))) 1 (atof xbl))
ybl (if (or (not ybl) (>= 0 (atof ybl))) 1 (atof ybl))
zbl (if (or (not zbl) (>= 0 (atof zbl))) 1 (atof zbl))
)
(if (not xqz) (setq xqz ""))
(if (not yqz) (setq yqz ""))
(if (not hqz) (setq hqz ""))
(if (not xhz) (setq xhz ""))
(if (not yhz) (setq yhz ""))
(if (not hhz) (setq hhz ""))
(if (or (not xjd) (> 0 (atoi xjd))) (setq xjd 3)(setq xjd (atoi xjd)))
(if (or (not yjd) (> 0 (atoi yjd))) (setq yjd 3)(setq yjd (atoi yjd)))
(if (or (not hjd) (> 0 (atoi hjd))) (setq hjd 3)(setq hjd (atoi hjd)))
(if (or (not defaultPJ) (>= 0 (atof defaultPJ))) (setq defaultPJ 7.5)(setq defaultPJ (atof defaultPJ)))
(if (not defaultFX) (setq defaultFX 45.0)(setq defaultFX (atof defaultFX)))
)
(defun cover-def (coverlist / $a $b $c $d $l)
(if (not coverlist)
(setq coverlist
(list (list "TEXTH" textH)
(list "WIDTH_F" width_f)
(list "SW_H" sw_h)
(list "DEFINEP" definep)
(list "BIAOZHUWEIZHI" biaozhuweizhi)
(list "QIANZHUI" qianzhui)
(list "XQZ" xqz)
(list "YQZ" yqz)? (list "HQZ" hqz)
(list "XHZ" xhz)? (list "YHZ" yhz)
(list "HHZ" hhz)? (list "XJD" xjd)
(list "YJD" yjd)? (list "HJD" hjd)
(list "defaultPJ" defaultPJ)
(list "defaultFX" defaultFX)
))
)
(if (setq $a (open savefile "w"))(progn
(write-line "//更改下面的參數設置的值,只有當重新開始一個新的文檔時才生效.//" $a)
(foreach $b coverlist ;(princ $b)
(if (not (cadr $b))(setq $b (list (car $b) "")))
(if (numberp (cadr $b))(setq $b (list (car $b) (rtos (cadr $b) 2 4))))
(if (= t (cadr $b))(setq $b (list (car $b) "t")))
(write-line (strcat (car $b) "====" (cadr $b)) $a)
)
(close $a)
))
)
(defun write_t($p1 $p2 $p3 $textH $biaozhuweizhi /
$a t1 t2 t3 c1 tem tem2 tem3 tem4 l1 LText
p5 p6 p7 p8 p9 $p11 $p12 $p13 $p14 in1 in2 in3
defaultFX1
;;;??????? yjd1 xjd1 hjd1
)
(setq defaultFX1 (/ (* pi defaultFX) 180.0))
(if (and $p1 (not $p2)) (progn
;;;??? (setq $p2 (polar $p1 (* pi 0.25) (* 2.5 $textH)))
(setq $p2 (polar $p1 defaultFX1 defaultPJ))
;;;??? (if biaozhuweizhi
;;;???? (setq $p3 (polar $p2 defaultFX1 1.0))
;;;???? (setq $p3 (polar $p2 0 1.0))
;;;??? )
))
(if (and $p1 $p2 (not $p3))(progn
(setq $a (angle $p1 $p2))
(if biaozhuweizhi
(setq $p3 (polar $p2 $a 1.0))
(if (and (< (* pi 0.5) $a) (> (* pi 1.5) $a))
(setq $p3 (polar $p2 pi 1.0))
(setq $p3 (polar $p2 0 1.0))
)
)
))
;; 多義線三點p1 $p2 $p3 字高p4
(setq t1 (if qianzhui (strcat yqz (rtos (/ (nth 0 $p1) ybl) 2 yjd) yhz) (rtos (/ (nth 0 $p1) ybl) 2 yjd))
t2 (if qianzhui (strcat xqz (rtos (/ (nth 1 $p1) xbl) 2 xjd) xhz) (rtos (/ (nth 1 $p1) xbl) 2 xjd))
t3 (if qianzhui (strcat hqz (rtos (/ (nth 2 $p1) zbl) 2 hjd) hhz) (rtos (/ (nth 2 $p1) zbl) 2 hjd)))
(setq $p11 (caadr (textbox (list (cons 1 t1))));
$p11 (/ $p11 (strlen t1)))
(setq LText (max (strlen t1) (strlen t2) (strlen t3)))
(setq LText (* $p11 (+ 0.5 Ltext)))
;
(setq p9 $p1)
(setq tem (if (< (nth 0 $p2) (nth 0 $p3)) $p2 $p3))
(setq tem2 (if (= tem $p2) 1 0))
(setq $p14 (if (= tem $p2) $p3 $p2))
(setq $p3 (angle $p2 $p3))
(setq $p1 (angle $p2 $p1))
(setq c1 (- $p3 $p1))
;;;
;;;判斷c1是銳角tem4=1還是鈍角tem4=0
;;;
(setq tem4 (if (and (>= (abs c1) 1.570796) (<= (abs c1) 4.7123892)) 0 1))
;;;
;;;判斷p3是在p1的左邊tem3=1還是右邊tem3=0
;;;
(setq tem3 (if (or (and (>= c1 0) (<= c1 3.1415926)) (and (>= c1 -6.2831852) (<= c1 -3.1415926))) 1 0))
;;;
;;;將p3化弧度為角度存放于p2
;;;
(setq $p2 (* $p3 57.29578049))
(setq $p2 (if (= tem2 0) (+ $p2 180) $p2))
;;;
;;;按字大小的0.25倍依比例計算行距p5
;;;
(setq p5 (* $textH 0.25))
;;;
;;;分別計算各行注記的起始位置
;;;
;;;tem4=1為銳角
;;;
(cond ((= tem4 1)
(progn
(cond ((and (= tem3 0) (= tem2 1))
(progn
(setq l1 (* (/ (cos (- 6.283185 c1)) (sin (- 6.283185 c1))) (+ (* p5 3) $textH)))
(setq $p11 (+ (atan p5 l1) $p3))
(setq p6 (sqrt (+ (* l1 l1) (* p5 p5))))
(setq $p12 (- $p3 (atan p5 l1)))
(setq p7 (sqrt (+ (* l1 l1) (* p5 p5))))
;????????????????? (setq $p12 (- $p3 (atan (+ p5 $textH) l1)))
;????????????????? (setq p7 (sqrt (+ (* l1 l1) (* (+ p5 $textH) (+ p5 $textH)))))
(setq $p13 (- $p3 (atan (+ (* 2 p5) (* 2 $textH)) l1)))
(setq p8 (sqrt (+ (* l1 l1) (* (+ (* 2 p5) (* 2 $textH)) (+ (* 2 p5) (* 2 $textH))))))
(setq l1 (- (+ Ltext l1) (distance tem $p14)))
))
((and (= tem3 0) (= tem2 0))
(progn
(setq l1 (abs (* (/ (cos (- 6.283185 c1)) (sin (- 6.283185 c1))) (+ (* p5 3) $textH))))
(setq l1 (- (+ Ltext l1) (distance tem $p14)))
(setq $p11 (if (< l1 0) (- $p3 (atan p5 l1)) (- $p3 (atan p5 l1))))
(setq p6 (sqrt (+ (* l1 l1) (* p5 p5))))
(setq $p12 (if (< l1 0) (+ $p3 (atan p5 l1)) (+ $p3 (atan p5 l1))))
(setq p7 (sqrt (+ (* l1 l1) (* p5 p5))))
;????????????????? (setq p7 (sqrt (+ (* l1 l1) (* (+ p5 $textH) (+ p5 $textH)))))
;????????????????? (setq $p12 (if (< l1 0) (+ $p3 (atan (+ p5 $textH) l1)) (+ $p3 (atan (+ p5 $textH) l1))))
(setq $p13 (if (< l1 0) (+ $p3 (atan (+ (* 2 p5) (* 2 $textH)) l1)) (+ $p3 (atan (+ (* 2 p5) (* 2 $textH)) l1))))
(setq p8 (sqrt (+ (* l1 l1) (* (+ (* 2 p5) (* 2 $textH)) (+ (* 2 p5) (* 2 $textH))))))
))
((and (= tem3 1) (= tem2 1))
(progn
(setq l1 (abs (* (/ (cos (- 6.283185 c1)) (sin (- 6.283185 c1))) (+ (* p5 4) (* 2 $textH)))))
(setq $p11 (+ (atan p5 l1) $p3))
(setq p6 (sqrt (+ (* l1 l1) (* p5 p5))))
(setq $p12 (- $p3 (atan p5 l1)))
(setq p7 (sqrt (+ (* l1 l1) (* p5 p5))))
;????????????????? (setq $p12 (- $p3 (atan (+ p5 $textH) l1)))
;????????????????? (setq p7 (sqrt (+ (* l1 l1) (* (+ p5 $textH) (+ p5 $textH)))))
(setq $p13 (- $p3 (atan (+ (* 2 p5) (* 2 $textH)) l1)))
(setq p8 (sqrt (+ (* l1 l1) (* (+ (* 2 p5) (* 2 $textH)) (+ (* 2 p5) (* 2 $textH))))))
(setq l1 (- (+ Ltext l1) (distance tem $p14)))
))
((and (= tem3 1) (= tem2 0))
(progn
(setq l1 (abs (* (/ (cos (- 6.283185 c1)) (sin (- 6.283185 c1))) (+ (* p5 3) $textH))))
(setq l1 (- (+ Ltext l1) (distance tem $p14)))
(setq $p11 (if (< l1 0) (- $p3 (atan p5 l1)) (- $p3 (atan p5 l1))))
(setq p6 (sqrt (+ (* l1 l1) (* p5 p5))))
(setq $p12 (if (< l1 0) (+ $p3 (atan p5 l1)) (+ $p3 (atan p5 l1))))
(setq p7 (sqrt (+ (* l1 l1) (* p5 p5))))
;????????????????? (setq $p12 (if (< l1 0) (+ $p3 (atan (+ p5 $textH) l1)) (+ $p3 (atan (+ p5 $textH) l1))))
;????????????????? (setq p7 (sqrt (+ (* l1 l1) (* (+ p5 $textH) (+ p5 $textH)))))
(setq $p13 (if (< l1 0) (+ $p3 (atan (+ (* 2 p5) (* 2 $textH)) l1)) (+ $p3 (atan (+ (* 2 p5) (* 2 $textH)) l1))))
(setq p8 (sqrt (+ (* l1 l1) (* (+ (* 2 p5) (* 2 $textH)) (+ (* 2 p5) (* 2 $textH))))))
))
)
))
;;;
;;;tem4=0為鈍角
;;;
((= tem4 0)
(cond ((= tem2 0)
(progn
(setq l1 (- Ltext (distance tem $p14)))
(setq $p11 (if (< l1 0) (- $p3 (atan p5 l1)) (- $p3 (atan p5 l1))))
(setq p6 (sqrt (+ (* l1 l1) (* p5 p5))))
(setq $p12 (if (< l1 0) (+ $p3 (atan p5 l1)) (+ $p3 (atan p5 l1))))
(setq p7 (sqrt (+ (* l1 l1) (* p5 p5))))
;????????????????? (setq $p12 (if (< l1 0) (+ $p3 (atan (+ p5 $textH) l1)) (+ $p3 (atan (+ p5 $textH) l1))))
(setq $p13 (if (< l1 0) (+ $p3 (atan (+ (* 2 p5) (* 2 $textH)) l1)) (+ $p3 (atan (+ (* 2 p5) (* 2 $textH)) l1))))
(setq p8 (sqrt (+ (* l1 l1) (* (+ (* 2 p5) (* 2 $textH)) (+ (* 2 p5) (* 2 $textH))))))
))
((= tem2 1)
(progn
(setq l1 (* 1.5 p5))
(setq $p11 (+ (atan p5 l1) $p3))
(setq p6 (sqrt (+ (* l1 l1) (* p5 p5))))
(setq $p12 (- $p3 (atan p5 l1)))
(setq p7 (sqrt (+ (* l1 l1) (* p5 p5))))
;????????????????? (setq $p12 (- $p3 (atan (+ p5 $textH) l1)))
;????????????????? (setq p7 (sqrt (+ (* l1 l1) (* (+ p5 $textH) (+ p5 $textH)))))
(setq $p13 (- $p3 (atan (+ (* 2 p5) (* 2 $textH)) l1)))
(setq p8 (sqrt (+ (* l1 l1) (* (+ (* 2 p5) (* 2 $textH)) (+ (* 2 p5) (* 2 $textH))))))
(setq l1 (- Ltext (distance tem $p14)))
)??? ))
)
)
;;;
(setq in1 (polar tem $p11 p6))
(setq in2 (polar tem $p12 p7))
(setq in3 (polar tem $p13 p8))
(if (= tem2 0) (setq tem (polar tem $p3 l1)) (setq $p14 (polar $p14 $p3 l1)))
;;;
;;;
(if (= tem2 0) (command "pline" p9 $p14 tem "") (command "pline" p9 tem $p14 ""))
(command "text" in1 $textH $p2 t2)
(command "text" "j" "tl" in2 $textH $p2 t1)
(if sw_h (command "text" in3 $textH $p2 t3))
(princ (strcat "\t" t2 "," t1 "," t3))
)
(defun mod_style( / entg1 _en)
(setq entg1 (entget (setq _en (tblobjname "style" "坐標")))
entg1 (subst (cons 41 width_f) (assoc 41 entg1) entg1))
(entmod entg1)(entupd _en)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;select1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun select1(sp / a)
(IF (or (= "W" sp)(= "ALL" sp)) (progn
(if (= "W" sp) (progn
(setq a (getreal (strcat "\n設置高寬比(" (rtos width_f 2 4) "): ")))
(cond ((not a))
((>= 0 a)(setq width_f 1))
(t (setq width_f a))
)
))
(mod_style)
))
(IF (or (= "H" sp)(= "ALL" sp)) (progn
(if (= "H" sp) (progn
(command "ortho" "on")
(setq a (getdist (strcat "\n輸入字高(" (rtos textH 2 4) ")?")))
(cond ((>= 0 a)(setq textH 1))
((= nil a))
(t (setq textH a))
)
(princ (strcat "新的字高=" (rtos textH 2 4)))
(command "ortho" "off")
))
(setvar "TEXTSIZE" textH)
))
(IF (= "S" sp)(progn
(setq sw_h (not sw_h))
(princ (if sw_h "\t顯示高程." "\t不顯示高程."))
))
(IF (= "Q" sp)(progn
(setq qianzhui (not qianzhui))
(princ (if qianzhui "\t顯示前綴和后綴." "\t不顯示前綴和后綴."))
))
(IF (= "P" sp)(progn
(setq definep (not definep))
(princ (if definep "\t需要指定文字位置." "\t不需要指定文字位置."))
))
(IF (= "A" sp)(progn
(setq biaozhuweizhi (not biaozhuweizhi))
(princ (if biaozhuweizhi "\t文字方向同引線方向打印." "\t文字方向橫向或豎向打印."))
))
;保存參數??????????????? 字高 比例???? 高? 指定位置?? 標注位置???? 前綴;
(setq define_biaozhu (list textH width_f sw_h definep biaozhuweizhi qianzhui
xqz yqz hqz xhz yhz hhz xjd yjd hjd
defaultFX defaultPJ
xbl ybl zbl
))
)
;;;
;;;
(setvar "CMDECHO" 0)
(if (setq style1 (tblsearch "style" "坐標"))
(progn
(setq width_f (cdr (assoc 41 style1)))
(if (/= "坐標" (getvar "textstyle"))(setvar "textstyle" "坐標"))
)
(command "style" "坐標" "黑體" 0 1 0 "" "")
)
(if (not define_biaozhu)
(progn
;設置原始參數
(read-def nil)
(cover-def nil)
(setvar "TEXTSIZE" textH)
;(select1 "ALL")
)
;讀取參數
(progn
(setq textH (nth 0 define_biaozhu)
width_f (nth 1 define_biaozhu)
sw_h (nth 2 define_biaozhu)
definep (nth 3 define_biaozhu)
biaozhuweizhi (nth 4 define_biaozhu)
qianzhui (nth 5 define_biaozhu)
xqz (nth 6 define_biaozhu) yqz (nth 7 define_biaozhu)
hqz (nth 8 define_biaozhu) xhz (nth 9 define_biaozhu)
yhz (nth 10 define_biaozhu) hhz (nth 11 define_biaozhu)
xjd (nth 12 define_biaozhu) yjd (nth 13 define_biaozhu)
hjd (nth 14 define_biaozhu)
defaultFX (nth 15 define_biaozhu)
defaultPJ (nth 16 define_biaozhu)
xbl (nth 17 define_biaozhu)
ybl (nth 18 define_biaozhu)
zbl (nth 19 define_biaozhu)
)
(if style1 (setq width_f (cdr (assoc 41 style1))))
(if (= 0 textH)(setq textH 1))
(if (= 0 width_f)(setq width_f 1))
(if (= 0 sw_h)(setq sw_h t))
(mod_style)
)
)
;;;
;;;
(setq m:err *error* *error* *merrmsg*)
(command "undo" "be")
(setq plw (getvar "plinewid")
old_aunits (getvar "aunits")
old_ORTHOMODE (getvar "ORTHOMODE")
)
(setvar "plinewid" 0)
(setvar "aunits" 0)
(setq oldos (getvar "osmode")); xqz "X=" yqz "Y=" hqz "H="
(if (not $in)(progn
(setvar "ORTHOMODE" 0)
(setvar "osmode" 553)
(setq? p1 "W" str "\n待標注的點[指定位置P/方向A/字高H/長寬比W/高程S/前后綴Q/選項X]:")
(princ (strcat "\n當前字高=" (rtos textH) ".長寬比=" (rtos width_f) ".高程"
(if (not sw_h) "不顯示."? "顯示.")))
(initget "W H S L P A Q X")
(while (setq p1 (getpoint str))
(cond
((= "U" p1)(command "undo" "back")(princ "\t退一步."))
((= "X" p1)(biaozhuxuanxiang))
;;;???? ((= "Q" p1)(setq qianzhui (not qianzhui))
;;;????? (if (setq qianzhui (not qianzhui))
;;;??????? (setq xqz "X=" yqz "Y=" hqz "H=")
;;;??????? (setq xqz "" yqz "" hqz "")
;;;????? )
;;;???? )
;;;???? ((= "P" p1)
;;;?????? (if (setq definep (not definep)) (princ "\t需要指定文字位置.")(princ "\t不需要指定文字位置."))
;;;?????? (select1 "")
;;;???? )
;;;???? ((= "A" p1)
;;;?????? (if (setq biaozhuweizhi (not biaozhuweizhi)) (princ "\t文字方向同引線方向.")(princ "\t需要指定文字方向."))
;;;?????? (select1 "")
;;;???? )
((or (= "Q" p1) (= "A" p1) (= "P" p1) (= "W" p1) (= "H" p1) (= "S" p1))
(select1 p1)
(cover-def nil)
)
((listp p1)
(command "undo" "mark")
(if definep (progn
(setq m (getvar "osmode"))
(command "osnap" "none")
(setq p2 (getpoint p1 "\n指定文字位置(空回車文字位置及方向按缺省方式):"))
(if p2 (progn
(command "ortho" "on")
(setq p3 (getpoint p2 "\n指定文字方向(空回車文字方向按缺省方向):"))
(command "ortho" "off")
))
(setvar "osmode" m)
))
(setq m (getvar "osmode"))
(setvar "osmode" 0)
(write_t p1 p2 p3 textH biaozhuweizhi)
(setvar "osmode" m)
(setq p1 nil p2 nil p3 nil)
))
(initget "W H S U L P A Q X")
(setq str "\n待標注的點[指定位置P/方向A/字高H/長寬比W/高程S/前后綴Q/選項X/退一步U]:")
)
)
(if (listp $in) (progn
(setq p1 $in)(undefinep)
))
)
(setvar "osmode" oldos)
(setvar "plinewid" plw)
(setvar "aunits" old_aunits)
(setvar "ORTHOMODE" old_ORTHOMODE)
(command "undo" "end")
(setvar "CMDECHO" 1)
(princ)
)
(defun c:biaozhu ()
(biaozhu-a nil)
)
posted on 2006-08-20 20:59 深藏記憶 閱讀(1386) 評論(3) ?編輯 ?收藏 所屬分類: Vlisp之韻
總結
以上是生活随笔為你收集整理的zbbz的lisp_学习LISP语言的体会的全部內容，希望文章能夠幫你解決所遇到的問題。
- 上一篇： 计算机基础雨课堂答案,雨课堂试卷批量导入
- 下一篇： tomcat乱码的几种解决