77077 发表于 2015-7-22 11:51:56

Alisp文字先创建后定位测试

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

lijiao 发表于 2015-7-22 14:15:49

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

77077 发表于 2016-4-20 23:12:58

本帖最后由 77077 于 2016-4-20 23:20 编辑


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

77077 发表于 2016-4-20 23:22:07

(defun C:TT (/ obj PT PT_OLD TEST TMP)      
    (setq modelspace (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object))))
    (setq PT_OLD (vlax-3D-point '(0 0)))
    (setq obj (vla-addtext modelspace "文字" PT_OLD 2.25))
    (princ "\n指定放置位置...")
    (setq TEST t)
    (while TEST
          (setq TMP (grread t 7 1))
          (cond
                  ((= (car TMP) 3) ;_左键
               (setq TEST NIL)
            )
            ((= (car TMP) 11) ;_右键
               (vla-delete obj)
               (setq TEST NIL)
            )
            ((= (car TMP) 5) ;_移动
               (setq PT (vlax-3D-point(cadr TMP)))
               (vla-Move obj PT_OLD PT)
               (setq PT_OLD PT)
            )
         )
   ) ;_结束 while
(princ)
)
页: [1]
查看完整版本: Alisp文字先创建后定位测试