Alisp文字先创建后定位测试

77077

2. (defun c:gg(/ tent gr el l pt)
   
3. (prompt "*********Alisp文字先创建后定位测试**********")
   
4. ;先创建
   
5. (setq tent (entmakex  '((0 . "text") (1 . "文字") (40 . 2) (10 0 0 0))))
   
6. ;后定位
   
7.   (while (and (setq gr (grread t 5 0))
   
8.               (eq 5 (car gr))
   
9.               )
   
10.      (setq pt (cadr gr)
    
11.            el (entget tent)
    
12.            l (assoc 10 el)
    
13.            el (subst (cons 10 pt) l el)
    
14.            )
    
15.      (entmod el)
    
16.     )
    
17. (princ)
    
18. );end defun

(defun c:gg(/ tent gr el l pt)<br /> (prompt "*********Alisp文字先创建后定位测试**********")<br /> ;先创建<br /> (setq tent (entmakex  '((0 . "text") (1 . "文字") (40 . 2) (10 0 0 0))))<br /> ;后定位<br />   (while (and (setq gr (grread t 5 0))<br />               (eq 5 (car gr))<br />               )<br />      (setq pt (cadr gr)<br />            el (entget tent)<br />            l (assoc 10 el)<br />            el (subst (cons 10 pt) l el)<br />            )<br />      (entmod el)<br />     )<br /> (princ)<br /> );end defun

lijiao

用这个函数(acet-ss-drag-move ss pt [prompt] [highlight [cursor]])，效果更好。

77077

2. 
   
3. (defun c:gg(/ obj PT PT_OLD)
   
4. (prompt "*********Vlisp文字先创建后定位测试**********")
   
5. ;先创建
   
6. (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
   
7. (setq PT_OLD (vlax-3D-point '(0 0)))
   
8. (setq obj (vla-addtext modelspace "文字" PT_OLD 2.25))
   
9. ;后定位
   
10.   (while (and (setq gr (grread t 5 0))
    
11.               (eq 5 (car gr))
    
12.               )
    
13.      (setq PT (vlax-3D-point(cadr gr)))
    
14.      (vla-Move obj PT_OLD PT)
    
15.      (setq PT_OLD PT)
    
16.     )
    
17. (princ)
    
18. )
    

<br /> (defun c:gg(/ obj PT PT_OLD)<br /> (prompt "*********Vlisp文字先创建后定位测试**********")<br /> ;先创建<br /> (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))<br /> (setq PT_OLD (vlax-3D-point '(0 0)))<br /> (setq obj (vla-addtext modelspace "文字" PT_OLD 2.25))<br /> ;后定位<br />   (while (and (setq gr (grread t 5 0))<br />               (eq 5 (car gr))<br />               )<br />      (setq PT (vlax-3D-point(cadr gr)))<br />      (vla-Move obj PT_OLD PT)<br />      (setq PT_OLD PT)<br />     )<br /> (princ)<br /> )<br />

77077

2. (defun C:TT (/ obj PT PT_OLD TEST TMP)        
   
3.     (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
   
4.     (setq PT_OLD (vlax-3D-point '(0 0)))
   
5.     (setq obj (vla-addtext modelspace "文字" PT_OLD 2.25))
   
6.     (princ "\n指定放置位置...")
   
7.     (setq TEST t)
   
8.     (while TEST
   
9.           (setq TMP (grread t 7 1))
   
10.           (cond
    
11.                     ((= (car TMP) 3) ;_左键
    
12.                (setq TEST NIL)
    
13.               )
    
14.               ((= (car TMP) 11) ;_右键
    
15.                (vla-delete obj)
    
16.                (setq TEST NIL)
    
17.               )
    
18.               ((= (car TMP) 5) ;_移动
    
19.                (setq PT (vlax-3D-point(cadr TMP)))
    
20.                (vla-Move obj PT_OLD PT)
    
21.                (setq PT_OLD PT)
    
22.               )
    
23.            )
    
24.    ) ;_结束 while
    
25.   (princ)
    
26. )

(defun C:TT (/ obj PT PT_OLD TEST TMP)        <br />     (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))<br />     (setq PT_OLD (vlax-3D-point '(0 0)))<br />     (setq obj (vla-addtext modelspace "文字" PT_OLD 2.25))<br />     (princ "\n指定放置位置...")<br />     (setq TEST t)<br />     (while TEST<br />           (setq TMP (grread t 7 1))<br />           (cond <br />                     ((= (car TMP) 3) ;_左键<br />                (setq TEST NIL)<br />               )<br />               ((= (car TMP) 11) ;_右键<br />                (vla-delete obj)<br />                (setq TEST NIL)<br />               )<br />               ((= (car TMP) 5) ;_移动<br />                (setq PT (vlax-3D-point(cadr TMP)))<br />                (vla-Move obj PT_OLD PT)<br />                (setq PT_OLD PT)<br />               )<br />            )<br />    ) ;_结束 while<br />   (princ)<br /> )