动态引线标注（改版） - AutoLISP/Visual LISP 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第3页

Bellahx 发表于 2014-4-10 10:52:04

冒昧的在楼主的基础上进行了修改，希望不要介意。
因为我们作图的要求是白色字，绿色线。而且每个图比例不同，需要的大小也不同。
修改过后，字高2.5，按照当前标注比例的全局比例进行修改，线为绿色，字为白色。

;;;动态引线标注
;;;支持线上下写字，字体由当前字体决定
;;;字高2.5，按标注比例标注
;;;字为白色，线为绿色
;;;作者：明经958620832
;;;修改：Bella          命令：bz       日期：2014年04月

(defun bz (/ *error* name1 name2 name3)
(defun *error* (msg) ;将描述错误的字符串存入变量msg
(entdel name1)
(entdel name2)
(if name3
   (entdel name3)
)
(princ "错误: ")
(princ msg)
) ;打印错误信息
(setq Scale (getvar "dimscale"));
(setq ty (getvar "TEXTSTYLE"))
(setq kd1 (caadr (textbox (list '(0 . "text")
   (cons 1 txt1)
   (cons 40 (* 2.5 Scale))
   (cons 41 1)
   (cons 7 ty)
   (cons 62 7)
      )
      )
      )
)
;字高2.5*当前比例，字宽高比1，可以自己设置，字体为当前字体
(setq kd2 (caadr (textbox (list '(0 . "text")
   (cons 1 txt2)
   (cons 40 (* 2.5 Scale))
   (cons 41 1)
   (cons 7 ty)
   (cons 62 7)
      )
      )
      )
)
;字高2.5*当前比例，字宽高比1，可以自己设置，字体为当前字体
(setq kd (max kd1 kd2)
   kd (+ kd (* 0.50 Scale))
)
(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") (* 0.70 Scale))
)
(setq p2 (polar pt 0 (/ (- kd kd2) 2))
      p2 (polar p2 (angtof "270") (* 3.20 Scale))
)
   )
)
(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") (* 0.70 Scale))
)
(setq p2 (polar p0 0 (/ (- kd kd2) 2))
      p2 (polar p2 (angtof "270") (* 3.20 Scale))
)
   )
)
(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)
      (cons 62 3)
)
)
(setq name1 (entlast))
(if name2
   (entdel name2)
)
(entmake (list '(0 . "text")
      (cons 1 txt1)
      (cons 40 (* 2.5 Scale))
      (cons 41 1)
      (cons 10 p1)
      (cons 7 ty)(cons 62 7)
)
)
;字高2.5*当前比例，字宽高比1，可以自己设置，字体为当前字体
(setq name2 (entlast))
(if name3
   (entdel name3)
)
(if (= kd3 1)
   (entmake (list '(0 . "text")
   (cons 1 txt2)
   (cons 40 (* 2.5 Scale))
   (cons 41 1)
   (cons 10 p2)
   (cons 7 ty)(cons 62 7)
      )
   )
)
;字高2.5*当前比例，字宽高比1，可以自己设置，字体为当前字体
(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)
)

(defun getdata ()
(setq txt1 (get_tile "a1"))
(setq txt2 (get_tile "a2"))
(if (= (get_tile "a3") "0")
(setq kd3 0)
(setq kd3 1)
)
)

(defun c:bz ()
;(步骤1)建立临时对话框
(setq tempname (vl-filename-mktemp "temp.dcl")
   filen    (open tempname "w")
)
(foreach stream
      '("yxbz:dialog{"
      "\nlabel = "
      动态引线标注
      ";"
      "\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;}"
      "\nok_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)
)

lucas_3333 发表于 2014-4-17 01:30:19

Bellahx 发表于 2014-4-10 10:52 static/image/common/back.gif
冒昧的在楼主的基础上进行了修改，希望不要介意。
因为我们作图的要求是白色字，绿色线。而且每个图比例不 ...

楼主如果能改成在DCL中直接设字高就好了

Bellahx 发表于 2014-4-17 10:46:15

lucas_3333 发表于 2014-4-17 01:30 static/image/common/back.gif
楼主如果能改成在DCL中直接设字高就好了

试着改了一下，我这边测没什么大问题，有点小问题希望大家指点。
1.在输入字高不合法的时候怎么直接报错跳出程序。
2.在对话框中输入后不能直接回车进行下一步，只能点击确认按钮，如果能的话会方便很多。
（再次，弱弱的希望楼主不要介意修改你的代码，一起学习）

;;;动态引线标注
;;;支持线上下写字，字体由当前字体决定
;;;字高2.5，按标注比例标注
;;;字为白色，线为绿色
;;;作者：明经958620832
;;;修改：          命令：yxbz       日期：2014年04月

(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 ht (atof txtht))
(if (= ht 0)
(progn
(prompt "字高为0!")
(terpri)
);progn
);if
(setq Scale (/ ht 2.5));
(setq kd1 (caadr (textbox (list '(0 . "text")
         (cons 1 txt1)
         (cons 40 ht)
         (cons 41 1)
         (cons 7 ty)
         (cons 62 7)
         )
      )
   )
)
      ;字高ht，字宽高比1，可以自己设置，字体为当前字体
(setq kd2 (caadr (textbox (list '(0 . "text")
         (cons 1 txt2)
         (cons 40 ht)
         (cons 41 1)
         (cons 7 ty)
         (cons 62 7)
         )
      )
   )
)
      ;字高ht，字宽高比1，可以自己设置，字体为当前字体
(setq kd (max kd1 kd2)
kd (+ kd (* 0.50 Scale))
)
(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") (* 0.70 Scale))
)
(setq p2 (polar pt 0 (/ (- kd kd2) 2))
      p2 (polar p2 (angtof "270") (* 3.20 Scale))
)
   )
)
(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") (* 0.70 Scale))
)
(setq p2 (polar p0 0 (/ (- kd kd2) 2))
      p2 (polar p2 (angtof "270") (* 3.20 Scale))
)
   )
)
(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)
         (cons 62 3)
   )
)
(setq name1 (entlast))
(if name2
   (entdel name2)
)
(entmake (list '(0 . "text")
         (cons 1 txt1)
         (cons 40 ht)
         (cons 41 1)
         (cons 10 p1)
         (cons 7 ty)(cons 62 7)
   )
)
      ;字高ht，字宽高比1，可以自己设置，字体为当前字体
(setq name2 (entlast))
(if name3
   (entdel name3)
)
(if (= kd3 1)
   (entmake (list '(0 . "text")
      (cons 1 txt2)
      (cons 40 ht)
      (cons 41 1)
      (cons 10 p2)
      (cons 7 ty)(cons 62 7)
      )
   )
)
      ;字高ht，字宽高比1，可以自己设置，字体为当前字体
(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)
)

(defun getdata ()
(setq txt1 (get_tile "a1"))
(setq txt2 (get_tile "a2"))
(if(= (get_tile "a3") "0")
(setq kd3 0)
(setq kd3 1)
)
(setq txtht(get_tile "a4"))
)

(defun c:yxbz ()
      ;(步骤1)建立临时对话框
(setq tempname (vl-filename-mktemp "temp.dcl")
filen (open tempname "w")
)
(foreach stream
   '("yxbz:dialog{"
      "\nlabel = "
      动态引线标注
      ";"
      "\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 {key = \"a4\"; label = \"文字高度:\"; width = 20; }"
      "\nok_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等函数）
(iftxt1
(set_tile "a1" txt1)
(set_tile "a1" "动态标注")
)
(iftxt2
(set_tile "a2" txt2)
(set_tile "a2" "动态标注")
)
(ifkd3
(set_tile "a3" (rtos kd3))
)       ;注意set_tile函数中赋值均为字符串（带双引号），就连关键词也要加上双引号。
(if(= kd3 0)
(mode_tile "a2" 1)
)
(if(= kd3 1)
(mode_tile "a2" 0)
)
(iftxtht
(set_tile "a4" txtht)
(set_tile "a4" "2.5")
)
(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)
)

lucas_3333 发表于 2014-4-17 11:38:54

Bellahx 发表于 2014-4-17 10:46 static/image/common/back.gif
试着改了一下，我这边测没什么大问题，有点小问题希望大家指点。
1.在输入字高不合法的时候怎么直接报错 ...

Bellahx 你好！
如果不考虑字高出错的问题，仅仅只需将源程序中的字高通过对话框更改，就像你上面的程序一下，需要更改哪些地方，能不能单独贴出来？谢谢！

Bellahx 发表于 2014-4-17 15:17:21

lucas_3333 发表于 2014-4-17 11:38 static/image/common/back.gif
Bellahx 你好！
如果不考虑字高出错的问题，仅仅只需将源程序中的字高通过对话框更改，就像你上面的程序 ...

没太理解你的问题(⊙o⊙)…麻烦详细说一下~

Htian11 发表于 2014-7-20 12:11:10

好厉害啊学习了

szx025 发表于 2014-7-20 13:53:31

如果能在程序中事先写入自己常用的词，标注文字时从事先写入自己常用的词中选择就好了，就是需要程序能读*.txt文件

chenbh2 发表于 2014-11-20 22:55:04

Bellahx 发表于 2014-4-10 10:52 static/image/common/back.gif
冒昧的在楼主的基础上进行了修改，希望不要介意。
因为我们作图的要求是白色字，绿色线。而且每个图比例不 ...

一个疑问是将字宽高比1修改0.7,线在哪里可以修改同步缩短?

photo_cup 发表于 2014-11-22 21:32:51

很不错...................

夺天工 发表于 2014-12-10 11:57:10

Bellahx 发表于 2014-4-10 10:52 static/image/common/back.gif
冒昧的在楼主的基础上进行了修改，希望不要介意。
因为我们作图的要求是白色字，绿色线。而且每个图比例不 ...

确实好用多了，继续

页: 1 2 [3] 4 5 6 7 8

明经CAD社区's Archiver