热门标签 | HotTags
当前位置:  开发笔记 > 编程语言 > 正文

zbbz的lisp_学习LISP语言的体会

自己从事的工作关系,利用autoCAD软件已经很多年了。有时候,遇到一些很机械很机械的工作,总想着能不能用程序来帮帮忙。于是,

自己从事的工作关系,利用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 &#39;("====") 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 (

(setq p6 (sqrt (+ (* l1 l1) (* p5 p5))))

(setq $p12 (if (

(setq p7 (sqrt (+ (* l1 l1) (* p5 p5))))

;                  (setq p7 (sqrt (+ (* l1 l1) (* (+ p5 $textH) (+ p5 $textH)))))

;                  (setq $p12 (if (

(setq $p13 (if (

(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 (

(setq p6 (sqrt (+ (* l1 l1) (* p5 p5))))

(setq $p12 (if (

(setq p7 (sqrt (+ (* l1 l1) (* p5 p5))))

;                  (setq $p12 (if (

;                  (setq p7 (sqrt (+ (* l1 l1) (* (+ p5 $textH) (+ p5 $textH)))))

(setq $p13 (if (

(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 (

(setq p6 (sqrt (+ (* l1 l1) (* p5 p5))))

(setq $p12 (if (

(setq p7 (sqrt (+ (* l1 l1) (* p5 p5))))

;                  (setq $p12 (if (

(setq $p13 (if (

(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之韵



推荐阅读
  • 本文详细介绍了Akka中的BackoffSupervisor机制,探讨其在处理持久化失败和Actor重启时的应用。通过具体示例,展示了如何配置和使用BackoffSupervisor以实现更细粒度的异常处理。 ... [详细]
  • 本文深入探讨 MyBatis 中动态 SQL 的使用方法,包括 if/where、trim 自定义字符串截取规则、choose 分支选择、封装查询和修改条件的 where/set 标签、批量处理的 foreach 标签以及内置参数和 bind 的用法。 ... [详细]
  • 本文详细介绍了Java中org.eclipse.ui.forms.widgets.ExpandableComposite类的addExpansionListener()方法,并提供了多个实际代码示例,帮助开发者更好地理解和使用该方法。这些示例来源于多个知名开源项目,具有很高的参考价值。 ... [详细]
  • 在前两篇文章中,我们探讨了 ControllerDescriptor 和 ActionDescriptor 这两个描述对象,分别对应控制器和操作方法。本文将基于 MVC3 源码进一步分析 ParameterDescriptor,即用于描述 Action 方法参数的对象,并详细介绍其工作原理。 ... [详细]
  • 本文详细介绍了如何构建一个高效的UI管理系统,集中处理UI页面的打开、关闭、层级管理和页面跳转等问题。通过UIManager统一管理外部切换逻辑,实现功能逻辑分散化和代码复用,支持多人协作开发。 ... [详细]
  • 本文详细探讨了JDBC(Java数据库连接)的内部机制,重点分析其作为服务提供者接口(SPI)框架的应用。通过类图和代码示例,展示了JDBC如何注册驱动程序、建立数据库连接以及执行SQL查询的过程。 ... [详细]
  • 技术分享:从动态网站提取站点密钥的解决方案
    本文探讨了如何从动态网站中提取站点密钥,特别是针对验证码(reCAPTCHA)的处理方法。通过结合Selenium和requests库,提供了详细的代码示例和优化建议。 ... [详细]
  • 本文介绍了如何使用JQuery实现省市二级联动和表单验证。首先,通过change事件监听用户选择的省份,并动态加载对应的城市列表。其次,详细讲解了使用Validation插件进行表单验证的方法,包括内置规则、自定义规则及实时验证功能。 ... [详细]
  • 本文详细介绍了如何使用 Yii2 的 GridView 组件在列表页面实现数据的直接编辑功能。通过具体的代码示例和步骤,帮助开发者快速掌握这一实用技巧。 ... [详细]
  • DNN Community 和 Professional 版本的主要差异
    本文详细解析了 DotNetNuke (DNN) 的两种主要版本:Community 和 Professional。通过对比两者的功能和附加组件,帮助用户选择最适合其需求的版本。 ... [详细]
  • 扫描线三巨头 hdu1928hdu 1255  hdu 1542 [POJ 1151]
    学习链接:http:blog.csdn.netlwt36articledetails48908031学习扫描线主要学习的是一种扫描的思想,后期可以求解很 ... [详细]
  • 本文详细介绍了Java中org.w3c.dom.Text类的splitText()方法,通过多个代码示例展示了其实际应用。该方法用于将文本节点在指定位置拆分为两个节点,并保持在文档树中。 ... [详细]
  • 在维护公司项目时,发现按下手机的某个物理按键后会激活相应的服务,并在屏幕上模拟点击特定坐标点。本文详细介绍了如何使用ADB Shell Input命令来模拟各种输入事件,包括滑动、按键和点击等。 ... [详细]
  • 解决Element UI中Select组件创建条目为空时报错的问题
    本文介绍如何在Element UI的Select组件中使用allow-create属性创建新条目,并处理创建条目为空时出现的错误。我们将详细说明filterable属性的必要性,以及default-first-option属性的作用。 ... [详细]
  • 毕业设计:基于机器学习与深度学习的垃圾邮件(短信)分类算法实现
    本文详细介绍了如何使用机器学习和深度学习技术对垃圾邮件和短信进行分类。内容涵盖从数据集介绍、预处理、特征提取到模型训练与评估的完整流程,并提供了具体的代码示例和实验结果。 ... [详细]
author-avatar
zjy396999
这个家伙很懒,什么也没留下!
PHP1.CN | 中国最专业的PHP中文社区 | DevBox开发工具箱 | json解析格式化 |PHP资讯 | PHP教程 | 数据库技术 | 服务器技术 | 前端开发技术 | PHP框架 | 开发工具 | 在线工具
Copyright © 1998 - 2020 PHP1.CN. All Rights Reserved | 京公网安备 11010802041100号 | 京ICP备19059560号-4 | PHP1.CN 第一PHP社区 版权所有