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

keyshoot

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

masterlong

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


(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

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

(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 (car  po) (car  ppp) 1)
                                                                (equal (cadr po) (cadr ppp) 1)
                                                        )
                                                        (vl-cmdf "ddedit" (setq a (entlast)) "")
                                                        (vl-cmdf "erase" (entlast) "")
                                                )
                                        )
                                )
                        )
                )
        )
(princ)
)

keyshoot

masterlong 发表于 2014-7-30 15:06
上面一个不支持正交模式
小改了一下

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

masterlong

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

香田里浪人

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

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

xyp1964

2. ;; 连续动态复制
   
3. (defun c:tt ()
   
4.   (if (setq s1 (car (entsel "\n选择文本: ")))
   
5.     (progn
   
6.       (setq mode t)
   
7.       (while mode
   
8.         (setq s1 (xyp-copy s1)
   
9.               a (xyp-GrreadMove s1 (xyp-DXF 10 s1))
   
10.         )
    
11.         (if (= a 3)
    
12.           (vl-cmdf "ddedit" s1 "")
    
13.           (progn (entdel (entlast)) (setq mode nil))
    
14.         )
    
15.       )
    
16.     )
    
17.   )
    
18.   (princ)
    
19. )

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

enn09

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

keyshoot

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

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

keyshoot

masterlong 发表于 2014-7-30 17:22
把
(setq po (cdr (assoc 10 (entget a))))
换成

嗯，可以啦