[讨论]：请教各位一个关于动态显示的问题

lzy9788

在lisp中能实现动态显示吗？比我要写入一个文字，再还没有指定文字输写点时，让文字随光标的移动显示在光标处。或是画一个矩形，圆，等什么的，让它在没指定插入点前随光标的移动显示在光标处。

wkai

结合grread函数 使用entmake和entdel来实现

aidraft

或者用块。。。
[php]
;;;Author: AIDraft  14/9/2004
;;;用法：(DynamicText "Here we go!" 3.0)
(defun DynamicText
       (txtstr height / mspace oldEcho doc txtobj blkdef entnum)
  (vl-load-com)
  (setq oldEcho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq mspace (vla-get-modelspace doc))
  (setq        txtobj
         (vla-addtext mspace txtstr (vlax-3d-point '(0 0 0)) height)
        )
;;;  (command "-purge" "b" "TXT*" "n")
  (setq LOOP T)
  (while LOOP
    (if
      (not (tblsearch
             "BLOCK"
             (setq bkname (strcat "TXT" (itoa (fix (* (random) 10000)))))
             )
           )
       (setq LOOP nil)
       ) ;endif
    )
  (setq blkdef (blk:make-block '(0 0 0) bkname (list txtobj) doc))
  (princ "\n指定文字插入点：")
  (setq entnum (sslength (ssget "x")))
  (command "-insert" (vla-get-name blkdef) pause 1 1 0)
  (if (< entnum (sslength (ssget "x")))
    (command ".explode" (entlast))
    )
  (command "-purge" "b" "TXT*" "n")
  (setvar "CMDECHO" oldEcho)
  )

;BLK:MAKE-BLOCK_______________________________________________
;Creates a block out of list of vla-objects
;Arguments
; 1) insertion point <(x y z)>
; 2) block name <string>
; 3) list of entities as vla-objects
; 4) document object
; 5) Use "*u" as the blockname argument to this function
;    TO MAKE AN UNNAMED BLOCK

(defun blk:make-block (ip blockname vla-objects doc / blkobj sArray)
  (setq
    blkobj (vla-add (vla-get-blocks doc) (vlax-3d-point ip) blockname)
    sArray
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-vbObject
               (cons 0 (1- (length vla-objects)))
               )
             vla-objects
             )
    )
  (vla-copyobjects doc sArray blkobj)
  blkobj
  )
;;
(defun random ()
  (- (* 1000000 (getvar "date")) (fix (* 1000000 (getvar "date"))))
  )[/php]

lzy9788

谢谢两位的指点，只是我不太会VL，所以有些还看不懂。
不过我又学到了东西。谢谢。
不知道哪位有没有纯lisp的例子。

梦断江南

最初由 aidraft 发布
[B]或者用块。。。
[php]
;;;Author: AIDraft  14/9/2004
;;;用法：(DynamicText "Here we go!" 3.0)
(defun DynamicText
       (txtstr height / mspace oldEcho doc txtobj blkdef entnum)
  (vl-load-com)
... [/B]

更简单一点的，可以选择或先造出实体后，用 ctrl+x (剪切),ctrl+v（粘贴）来实现动态定位。要定制移动基点的，可以用_copybase

或则利用move命令

aidraft

Good idea!
Move? I have tried, but I cannot get rid of the rubber-band line...

It can be so simple. That's amazing!
[php](defun DynText  (txtstr height)
  (entmake (list
             '(0 . "TEXT")
             '(100 . "AcDbEntity")
             (cons 8 (getvar "CLAYER"))
             '(100 . "AcDbText")
             '(10 0.0 0.0 0.0)
             (cons 40 height)
             (cons 1 txtstr)
             '(50 . 0.0)
             '(41 . 1.0)
             '(51 . 0.0)
             (cons 7 (getvar "TEXTSTYLE"))
             '(71 . 0)
             '(72 . 0)
             '(11 0.0 0.0 0.0)
             '(210 0.0 0.0 1.0)
             '(100 . "AcDbText")
             '(73 . 0)
             ) ;list
           ) ;entmake
  (command "copyclip" (entlast) "")
  (entdel (entlast))
  (command "pasteclip" pause)
)
[/php]

lzy9788

grread怎么样结合entdel entmake使用

urljit

对呀，请wkai斑竹说说，grread怎么样结合entdel entmake使用 ？

wkai

结合grread entdel  entmake  实现动态创建TEXT的代码如下

2. 
   
3. (DEFUN ddtxt (txt height / el run n)
   
4. (DEFUN        mktxt (txt height pt)
   
5.   (entmake (LIST
   
6.               '(0 . "TEXT")
   
7.               (CONS 10 pt)
   
8.               (CONS 40 height)
   
9.               (CONS 1 txt)
   
10.               (CONS 7 (GETVAR "TEXTSTYLE"))
    
11.              )
    
12. 
    
13.   )
    
14. )
    
15. (SETQ run T)
    
16. (WHILE        (AND run (SETQ n (GRREAD T 1)))
    
17.   (COND        ((= 5 (CAR n));;;移动鼠标
    
18.         [color=red] (AND el (ENTDEL el))
    
19.          (mktxt txt height (CADR n))[/color]
    
20.          (SETQ el (ENTLAST))
    
21.         )
    
22.         ((= 3 (CAR n));;;点击左键
    
23.          (AND el (ENTDEL el))
    
24.          (mktxt txt height (CADR n))
    
25.          (SETQ run nil)
    
26.         )
    
27.   )
    
28. )
    
29. )
    
30. 
    
31. (defun c:tt()
    
32. (ddtxt (getstring "\n文字内容:") (/ (getvar "viewsize")10))
    
33. )

<br /> (DEFUN ddtxt (txt height / el run n)<br /> (DEFUN        mktxt (txt height pt)<br />   (entmake (LIST<br />               '(0 . "TEXT")<br />               (CONS 10 pt)<br />               (CONS 40 height)<br />               (CONS 1 txt)<br />               (CONS 7 (GETVAR "TEXTSTYLE"))<br />              )<br /> <br />   )<br /> )<br /> (SETQ run T)<br /> (WHILE        (AND run (SETQ n (GRREAD T 1)))<br />   (COND        ((= 5 (CAR n));;;移动鼠标<br />         [color=red] (AND el (ENTDEL el))<br />          (mktxt txt height (CADR n))[/color]<br />          (SETQ el (ENTLAST))<br />         )<br />         ((= 3 (CAR n));;;点击左键<br />          (AND el (ENTDEL el))<br />          (mktxt txt height (CADR n))<br />          (SETQ run nil)<br />         )<br />   )<br /> )<br /> )<br /> <br /> (defun c:tt()<br /> (ddtxt (getstring "\n文字内容:") (/ (getvar "viewsize")10))<br /> )

netbee

[iframe h=600]http://www.xdcad.net/forum/showthread.php?postid=1145008#post1145008[/iframe]

lzy9788

多谢斑竹。

urljit

俺也看到了，也跟着谢谢斑竹吧，不过，问题是要显示的entity多就得entmake很多，然后entdel，这样是不是很占用机器资源？

aeo

最初由 urljit 发布
[B]俺也看到了，也跟着谢谢斑竹吧，不过，问题是要显示的entity多就得entmake很多，然后entdel，这样是不是很占用机器资源？ [/B]

可以用entmod,不过是差不多的.
lisp就得这样,不然还有人用arx呀?

它山之石

我是利用插入块来实现的。
贴个例子吧。这是我写了用在鼠标中键上的。

2. 
   
3. (defun C:%%1306@75(/ ss lay os)
   
4.   (princ (strcat"\n***均布钢筋自动标注软件V030225  葛磊***"))
   
5.   (princ (strcat"\n        [共享软件，版权所有]"))
   
6.   (princ)
   
7.   (terpri)
   
8.   (setvar "CMDECHO" 0)
   
9.   (setq os (getvar "OSMODE"))
   
10.   (setvar "OSMODE" (if (> os 16383) os (+ 16384 os)))
    
11.   (setq lay (getvar "clayer"))
    
12. 
    
13.   (if (or (= nil (tblsearch "layer" "钢筋标注"))
    
14.           (/= (cdr (assoc 8 (tblsearch "layer" "钢筋标注"))) 0)
    
15.       )
    
16.       (command "layer" "m" "钢筋标注" "c" "255" "钢筋标注" "")
    
17.       (command "layer" "s" "钢筋标注" "" "")
    
18.   )
    
19. 
    
20.   (if (or (= nil (tblsearch "style" "standard"))
    
21.           (/= (cdr (assoc 40 (tblsearch "style" "standard"))) 0)
    
22.       )
    
23.       (command "STYLE" "standard" "romans" "0" ".8" "0" "n" "n" "n")
    
24.   )
    
25.   (setq ss (ssadd))
    
26.   (command "text" "s" "standard" "j" "c" "0,0" "250" "0" "%%1306@75")
    
27.   (setq ss (ssadd (entlast) ss))  
    
28.   (command "block" "i6-75" "0,0" ss "")
    
29.   (command "_insert" "i6-75" pause "" "" "")
    
30.   (command "explode" "l")
    
31.   (command "purge" "b" "i6-75" "n")
    
32.   (command "layer" "s" lay "")
    
33.   (setvar "osmode" os)
    
34.   (princ (strcat"\n***均布钢筋自动标注软件V030225  葛磊***"))
    
35.   (princ (strcat"\n        [共享软件，版权所有]"))
    
36.   (princ)
    
37. )
    
38. 
    

<br /> (defun C:%%1306@75(/ ss lay os)<br />   (princ (strcat"\n***均布钢筋自动标注软件V030225  葛磊***"))<br />   (princ (strcat"\n        [共享软件，版权所有]"))<br />   (princ)<br />   (terpri)<br />   (setvar "CMDECHO" 0)<br />   (setq os (getvar "OSMODE"))<br />   (setvar "OSMODE" (if (> os 16383) os (+ 16384 os)))<br />   (setq lay (getvar "clayer"))<br /> <br />   (if (or (= nil (tblsearch "layer" "钢筋标注"))<br />           (/= (cdr (assoc 8 (tblsearch "layer" "钢筋标注"))) 0)<br />       )<br />       (command "layer" "m" "钢筋标注" "c" "255" "钢筋标注" "")<br />       (command "layer" "s" "钢筋标注" "" "")<br />   )<br /> <br />   (if (or (= nil (tblsearch "style" "standard"))<br />           (/= (cdr (assoc 40 (tblsearch "style" "standard"))) 0)<br />       )<br />       (command "STYLE" "standard" "romans" "0" ".8" "0" "n" "n" "n")<br />   )<br />   (setq ss (ssadd))<br />   (command "text" "s" "standard" "j" "c" "0,0" "250" "0" "%%1306@75")<br />   (setq ss (ssadd (entlast) ss))  <br />   (command "block" "i6-75" "0,0" ss "") <br />   (command "_insert" "i6-75" pause "" "" "")<br />   (command "explode" "l")<br />   (command "purge" "b" "i6-75" "n") <br />   (command "layer" "s" lay "")<br />   (setvar "osmode" os)<br />   (princ (strcat"\n***均布钢筋自动标注软件V030225  葛磊***"))<br />   (princ (strcat"\n        [共享软件，版权所有]"))<br />   (princ)<br /> )<br /> <br />

ycao

谢谢各位高手，学到了不少东西。