动态引线标注点击生成时求增加捕捉功能，谢谢~

逗亦斗霸 · 发表于 2024-10-9 11:14:27

(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{"
"\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 {key = "a4"; label = "文字高度:"; width = 20; }"
"\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)
)
(if txtht
(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)
)

(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{" 
         "\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 {key = "a4"; label = "文字高度:"; width = 20; }" 
         "\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) 
    ) 
    (if  txtht 
  (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) 
)

论坛上的代码，希望最后点击生成时增加捕捉功能，以便能定位到指定位置，多个标注的话也能对齐，求大佬指点怎么改进，谢谢~

kozmosovia · 发表于 2024-10-9 13:36:30

生成引线pline前先osnap一下pt，再相应更新一下p0

逗亦斗霸 · 发表于 2024-10-9 14:30:40

kozmosovia 发表于 2024-10-9 13:36
生成引线pline前先osnap一下pt，再相应更新一下p0

求详细指导~

qazxswk · 发表于 2024-10-9 22:19:46

用了grread函数，想实现捕捉功能，很难。要改变一下思路。

panliang9 · 发表于 2024-10-10 09:02:24

看G版的“自定义带捕捉的grread函数”
http://bbs.mjtd.com/forum.php?mo ... 4grread%BA%AF%CA%FD

逗亦斗霸 · 发表于 2024-10-10 10:30:23

panliang9 发表于 2024-10-10 09:02
看G版的“自定义带捕捉的grread函数”
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91191&highligh ...

这个帖子我搜到过，但没看懂，有部分内容暂时还没权限看~

kozmosovia · 发表于 2024-10-10 10:33:25

这么写代码。弄grread，还不如直接command mleader来得好

逗亦斗霸 · 发表于 2024-10-10 14:46:15

kozmosovia 发表于 2024-10-10 10:33
这么写代码。弄grread，还不如直接command mleader来得好

可是需要这样的样式啊，并且mleader不能在水平横线上下都有文字吧？

kozmosovia · 发表于 2024-10-10 16:11:09

样式可以定义，

账号		自动登录	找回密码
密码			注册

[提问] 动态引线标注点击生成时求增加捕捉功能，谢谢~

相关帖子

本帖子中包含更多资源