本帖最后由 zxq0220 于 2014-4-17 09:00 编辑
- <P>(defun bz (/ *error* name1 name2 name3)
- (defun *error* (msg) ;将描述错误的字符串存入变量msg
- (entdel name1) (entdel name2) (if name3 (entdel name3))
- (princ "错误: ")(princ msg)) ;打印错误信息
- (setq ty (getvar "TEXTSTYLE"))
- (setq kd1 (caadr (textbox (list '(0 . "text")(cons 1 txt1)(cons 40 th)(cons 41 0.7)(cons 7 ty)))))
- ;字高th，字宽高比0.7，可以自己设置，字体为当前字体
- (setq kd2 (caadr (textbox (list '(0 . "text")(cons 1 txt2)(cons 40 th)(cons 41 0.7)(cons 7 ty)))))
- ;字高th，字宽高比0.7，可以自己设置，字体为当前字体
- (setq kd (max kd1 kd2) kd (+ kd 50))
- (setq p (getpoint "\n输入基点:"))
- (setq pd t)
- (while pd
- (setq gr (grread t 4 1) mode (car gr) pt (cadr gr))
- (if (= kd3 0) (setq kd kd1))
- (if (and (listp pt) (>= (car pt) (car p))) (progn
- (setq p0 (polar pt 0 kd))
- (setq p1 (polar pt 0 (/ (- kd kd1) 2)) p1 (polar p1 (angtof "90") 50))
- (setq p2 (polar pt 0 (/ (- kd kd2) 2)) p2 (polar p2 (angtof "270") 350))))
- (if (and (listp pt) (< (car pt) (car p))) (progn
- (setq p0 (polar pt pi kd))
- (setq p1 (polar p0 0 (/ (- kd kd1) 2)) p1 (polar p1 (angtof "90") 50))
- (setq p2 (polar p0 0 (/ (- kd kd2) 2)) p2 (polar p2 (angtof "270") 350))))
- (if (= mode 5) (progn
- (if name1 (entdel name1))
- (entmake (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")'(90 . 3)
- (cons 10 p)(cons 10 pt)(cons 10 p0)))
- (setq name1 (entlast))
- (if name2 (entdel name2))
- (entmake (list '(0 . "text")(cons 1 txt1)(cons 40 th)(cons 41 0.7)(cons 10 p1)(cons 7 ty)))
- ;字高th，字宽高比0.7，可以自己设置，字体为当前字体
- (setq name2 (entlast))
- (if name3 (entdel name3))
- (if (= kd3 1) (entmake (list '(0 . "text")(cons 1 txt2)(cons 40 th)(cons 41 0.7)(cons 10 p2)(cons 7 ty))))
- ;字高th，字宽高比0.7，可以自己设置，字体为当前字体
- (if (= kd3 1) (setq name3 (entlast)))))
- (if (= mode 3) (setq pd nil))
- (if (or (= mode 2) (= mode 25)) (progn (setq pd nil) (entdel name1) (entdel name2) (if name3 (entdel name3)))))
- (princ))</P>
- <P>(defun getdata ()
- (setq txt1 (get_tile "a1"))
- (setq txt2 (get_tile "a2"))
- (setq kd3 (get_tile "a3"))
- (setq th (read(get_tile "tx_hig")))
- )
- (defun c:yxbz ()
- ;(步骤1)建立临时对话框
- (setq tempname (vl-filename-mktemp "temp.dcl") filen (open tempname "w"))
- (foreach stream
- '("yxbz:dialog{"
- "\n label="动态引线标注";"
- "\n :edit_box {key="a1"; label="线上文字:"; width=40 ;}"
- "\n :toggle {key="a3"; label="增加线下文字"; value="0";}"
- "\n :edit_box {key="a2"; label="线下文字:"; width=40; is_enabled = false;}"
- "\n :edit_box{label="文字高:"; key="tx_hig"; value="2.5"; edit_width = 4; }"
- "\n ok_cancel;}")
- (princ stream filen))
- (close filen)
- (setq dclname tempname)
- ;(步骤2)加载并显示对话框
- (setq dcl_re (load_dialog dclname))
- (if (not (new_dialog "yxbz" dcl_re)) (exit))
- ;(步骤3)定义对话框控件（运用set_tile、action_tile、mode_tile、get_tile等函数）
- (if txt1 (set_tile "a1" txt1) (set_tile "a1" "动态标注"))
- (if txt2 (set_tile "a2" txt2) (set_tile "a2" "动态标注"))
- (if kd3 (set_tile "a3" (rtos kd3))) ;注意set_tile函数中赋值均为字符串（带双引号），就连关键词也要加上双引号。
- (if (= kd3 0) (mode_tile "a2" 1))
- (if (= kd3 1) (mode_tile "a2" 0))
- (action_tile "a3" "(if (= (get_tile "a3") "0") (mode_tile "a2" 1) (mode_tile "a2" 0))") ;点击时才起作用
- (action_tile "accept" "(getdata)(done_dialog 1)")
- (action_tile "cancel" "(done_dialog)")
- ;(步骤4)激活并卸载对话框，并进行对话框隐藏后的操作。
- (setq std (start_dialog))
- (unload_dialog dcl_re)
- (vl-file-delete dclname)
- (if (= std 1) (bz))
- (princ)
- </P>
| 
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园
( 辽ICP备15016793号 )
窥视卡
雷达卡
已领礼包: 
财富等级: 
发表于 2014-4-17 01:39:56
提升卡
置顶卡
沉默卡
变色卡
千斤顶
发表于 2014-4-17 09:31:01
