keyshoot 发表于 2014-7-30 11:59:18

求个选择文字基点，连续复制编辑的梁山泊

经常要原位标注钢筋，，求个选择文字基点连续复制编辑的 lsp。
具体功能：选择文字及其基点后，连续复制并自动进入编辑，当文字输入后鼠标点击另一基点即完成文字输入，并进入另一个文字编辑输入（文字内容为上次输入的文字）。

masterlong 发表于 2014-7-30 14:34:36

基本上按照你的意思来的
呃
注意在选复制目标点时
鼠标不要去做一些高难度的动作
比如快速移动且双击啥的


(defun c:tt()
        (if (setq a (ssget ":e:s" '((0 . "text"))))
                (progn
                        (setq a (ssname a 0))
                        (setq po (cdr (assoc 10 (entget a))))
                        (setq tt (cdr (assoc 1 (entget a))))
                       
                        (setq pt Nil)
                        (while (not (equal po pt 1e-4))
                                (setq pt po)
                                (vl-cmdf "copy" a "" "non" pt pause)
                                (setq po (getvar "lastpoint"))
                                (setq ppp (cadr (grread T)))
                                (if (equal po ppp 1)
                                        (vl-cmdf "ddedit" (setq a (entlast)) "")
                                        (vl-cmdf "erase" (entlast) "")
                                )
                        )
                )
        )
(princ)
)

masterlong 发表于 2014-7-30 15:06:59

上面一个不支持正交模式
小改了一下

(defun c:tt()
        (if (setq a (ssget ":e:s" '((0 . "text"))))
                (progn
                        (setq a (ssname a 0))
                        (setq po (cdr (assoc 10 (entget a))))
                        (setq tt (cdr (assoc 1 (entget a))))
                       
                        (setq pt Nil)
                        (while (not (equal po pt 1e-4))
                                (setq pt po)
                                (if (vl-cmdf "copy" a "" "non" pt pause)
                                        (progn
                                                (setq po (getvar "lastpoint"))
                                                (setq ppp (cadr (grread T)))
                                                (if (or
                                                                (equal (carpo) (carppp) 1)
                                                                (equal (cadr po) (cadr ppp) 1)
                                                        )
                                                        (vl-cmdf "ddedit" (setq a (entlast)) "")
                                                        (vl-cmdf "erase" (entlast) "")
                                                )
                                        )
                                )
                        )
                )
        )
(princ)
)

keyshoot 发表于 2014-7-30 15:32:46

masterlong 发表于 2014-7-30 15:06 static/image/common/back.gif
上面一个不支持正交模式
小改了一下



好像没办法选择基点哦。只能用文字的好像插入点捕捉

masterlong 发表于 2014-7-30 17:22:32

把
(setq po (cdr (assoc 10 (entget a))))
换成
(setq po (getpoint "\n指定基点: "))

香田里浪人 发表于 2014-7-30 20:37:25

masterlong 发表于 2014-7-30 14:34 static/image/common/back.gif
基本上按照你的意思来的
呃
注意在选复制目标点时


程序不错，有创意，有使用价值

xyp1964 发表于 2014-7-30 21:43:52

本帖最后由 xyp1964 于 2014-7-30 22:17 编辑

;; 连续动态复制
(defun c:tt ()
(if (setq s1 (car (entsel "\n选择文本: ")))
    (progn
      (setq mode t)
      (while mode
      (setq s1 (xyp-copy s1)
            a (xyp-GrreadMove s1 (xyp-DXF 10 s1))
      )
      (if (= a 3)
          (vl-cmdf "ddedit" s1 "")
          (progn (entdel (entlast)) (setq mode nil))
      )
      )
    )
)
(princ)
)

enn09 发表于 2014-7-31 09:04:25

好程序，挺实用的，赞一个~

keyshoot 发表于 2014-7-31 11:07:23

xyp1964 发表于 2014-7-30 21:43 static/image/common/back.gif


不知道为什么，容易出错。

keyshoot 发表于 2014-7-31 11:07:56

masterlong 发表于 2014-7-30 17:22 static/image/common/back.gif
把
(setq po (cdr (assoc 10 (entget a))))
换成


嗯，可以啦
页: [1] 2
查看完整版本: 求个选择文字基点，连续复制编辑的梁山泊