社区 › AutoLISP/Visual LISP 编程技术 › 动态引线标注点击生成时求增加捕捉功能，谢谢~

逗亦斗霸 发表于 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{"
         "\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)
)论坛上的代码，希望最后点击生成时增加捕捉功能，以便能定位到指定位置，多个标注的话也能对齐，求大佬指点怎么改进，谢谢~

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

求详细指导~:lol

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

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

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

看G版的“自定义带捕捉的grread函数”
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91191&highlight=%D7%D4%B6%A8%D2%E5%B4%F8%B2%B6%D7%BD%B5%C4grread%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 ...

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

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

样式可以定义，

查看完整版本: 动态引线标注点击生成时求增加捕捉功能，谢谢~