求一个双击单行文本直接跳出对话框的lisp程序

yangist · 发表于 2013-6-25 21:35:03

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

求一个双击单行文本直接跳出对话框的lisp程序
最好能显示字高之类的属性,没有也可以

xshrimp · 发表于 2013-6-25 21:48:25

;;----------------------=={ Edit Box }==----------------------;;
;; ;;
;; Displays a DCL Edit Box to obtain a string from the user ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; string - initial value to display ("" for none) ;;
;;------------------------------------------------------------;;
;; Returns: Edit box contents if user pressed OK, else nil ;;
;;------------------------------------------------------------;;
(defun LM:EditBox ( string / id )
(and
(< 0 (setq id (load_dialog "ACAD")))
(new_dialog "acad_txtedit" id)
(set_tile "text_edit" string)
(action_tile "text_edit" "(setq string $value)")
(if (zerop (start_dialog)) (setq string nil))
)
(if (< 0 id) (unload_dialog id))
string
)

;;----------------------=={ Edit Box }==----------------------;; 
;;                                                            ;; 
;;  Displays a DCL Edit Box to obtain a string from the user  ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright &#169; 2011 - <a href=\"http://www.lee-mac.com\" target=\"_blank\">www.lee-mac.com</a>       ;; 
;;------------------------------------------------------------;; 
;;  Arguments:                                                ;; 
;;  string - initial value to display ("" for none)           ;; 
;;------------------------------------------------------------;; 
;;  Returns: Edit box contents if user pressed OK, else nil   ;; 
;;------------------------------------------------------------;; 
 
(defun LM:EditBox ( string / id ) 
  (and 
    (< 0 (setq id (load_dialog "ACAD"))) 
    (new_dialog "acad_txtedit" id) 
    (set_tile    "text_edit"  string) 
    (action_tile "text_edit" "(setq string $value)") 
    (if (zerop (start_dialog)) (setq string nil)) 
  ) 
  (if (< 0 id) (unload_dialog id)) 
  string 
)

(LM:EditBox "Lee Mac")

Free-Lancer · 发表于 2013-6-25 22:58:45

这些自己还要写也太累了吧

yxpxa · 发表于 2013-6-25 23:03:57

http://bbs.xdcad.net/forum.php?m ... p;extra=#pid3465158

yangist · 发表于 2013-6-25 23:54:39

yxpxa 发表于 2013-6-25 23:03
http://bbs.xdcad.net/forum.php?mod=viewthread&tid=668867&page=1&extra=#pid3465158

满好的就是太复杂了也不能双击触发

yangist · 发表于 2013-6-25 23:55:22

本帖最后由 yangist 于 2013-6-25 23:56 编辑

xshrimp 发表于 2013-6-25 21:48
(LM:EditBox "Lee Mac")

LM:EditBox 详细解释下么怎么用呢

QiaoCheng · 发表于 2013-6-26 00:09:17

yangist 发表于 2013-6-25 23:55
LM:EditBox 详细解释下么怎么用呢

(LM:EditBox (Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'TextString ))

yangist · 发表于 2013-6-26 08:37:38

QiaoCheng 发表于 2013-6-26 00:09
(LM:EditBox (Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'TextString ))

朋友能直接写个能用的程序么我是新手这些个看不懂也用不了啊

QiaoCheng · 发表于 2013-6-26 08:54:06

yangist 发表于 2013-6-26 08:37
朋友能直接写个能用的程序么我是新手这些个看不懂也用不了啊

[pcode=lisp,true]

(defun c:qe ( / en st )
 (if
(and
 (setq en (car (nentsel)))
 (wcmatch (cdr (assoc 0 (setq en (entget en)))) "TEXT,ATTRIB")
 (setq st (LM:EditBox (cdr (assoc 1 en))))
)
(entupd (cdr (assoc -1 (entmod (list (assoc -1 en) (cons 1 st))))))
 )
 (princ)
)
(defun LM:EditBox ( string / id )
 (and
(< 0 (setq id (load_dialog "ACAD")))
(new_dialog "acad_txtedit" id)
(set_tile "text_edit" string)
(action_tile "text_edit" "(setq string $value)")
(if (zerop (start_dialog)) (setq string nil))
 )
 (if (< 0 id) (unload_dialog id))
 string
)

[/pcode]

HLCAD · 发表于 2013-6-26 14:17:31

QiaoCheng 发表于 2013-6-26 08:54
(defun c:qe ( / en st )
(if
(and

精彩！精华！
(entupd (cdr (assoc -1 (entmod (list (assoc -1 en) (cons 1 st))))))
我又学到了一招！非常感谢!

/db_自贡黄明儒_ · 发表于 2013-6-26 14:47:24

从标题上看，楼主要的是双击文本的反应器

Free-Lancer · 发表于 2013-6-26 16:07:57

单击后的快捷属性面板够用了

/db_自贡黄明儒_ · 发表于 2013-6-26 16:30:47

本帖最后由 /db_自贡黄明儒_ 于 2013-6-26 16:34 编辑

Free-Lancer 发表于 2013-6-26 16:07
单击后的快捷属性面板够用了

赞同，但双击文本变色时还是有用的，G版在明经上回答这一问题时，我看到过
下面是我改编过的

;;;;;;;;;;;;;;;;;;;双击空白处执行HH命令
;;; 加载双击反应器
(if (not *dblclkReactor*)
;;0 = 打开反应器
(setq *dblclkReactor*
(VLR-Mouse-Reactor
nil
'((:VLR-beginDoubleClick . dblclkedit))
)
)
)
;;;;;;;;;
(defun dblclkedit (reactorObject point)
;; 自定义双击反应器,空启动HH;文本则变色
(defun dblclk-edit (dblclk_point / owner dblclk_etype p B DOC ENT color1)
(setq owner (nentselp (setq p (trans (car dblclk_point) 0 1))))
;;指定点来选择对象
(if (and (= (vla-get-ActiveSpace
(vla-get-activedocument (vlax-get-acad-object))
)
1
)
(= 0 (getvar 'cmdactive))
)
(if (= owner nil)
(vla-sendcommand
(vla-get-activedocument (vlax-get-acad-object))
(strcat (rtos (car p) 2 3) "," (rtos (cadr p) 2 3) " HH ")
)
(progn
(if (> (length owner) 2)
(setq ent (last (last owner)))
(setq ent (car owner))
)
(setq b (cdr (assoc 0 (entget ent)))
doc (vlax-get (vlax-get-acad-object) "activedocument")
)
(if (wcmatch b "*TEXT,ATTDEF")
(progn (setq ent (vlax-ename->vla-object ent)) (if (> (setq color1 (vla-get-Color ent)) 5)(setq color1 0))(vla-put-Color ent (1+ color1)))
)
)
)
)
)
(if dblclk-edit
(dblclk-edit point)
)
)
;;;;;;;;;;;;;;;;;;;双击空白处执行HH命令;文本则变色

;;;;;;;;;;;;;;;;;;;双击空白处执行HH命令 
;;; 加载双击反应器 
(if (not *dblclkReactor*) 
  ;;0 = 打开反应器 
  (setq  *dblclkReactor* 
   (VLR-Mouse-Reactor 
     nil 
     '((:VLR-beginDoubleClick . dblclkedit)) 
   ) 
  ) 
) 
 
;;;;;;;;; 
(defun dblclkedit (reactorObject point) 
 
  ;; 自定义双击反应器,空启动HH;文本则变色 
  (defun dblclk-edit (dblclk_point / owner dblclk_etype p B DOC ENT color1) 
    (setq owner (nentselp (setq p (trans (car dblclk_point) 0 1)))) 
    ;;指定点来选择对象 
    (if  (and (=  (vla-get-ActiveSpace 
      (vla-get-activedocument (vlax-get-acad-object)) 
    ) 
    1 
       ) 
       (= 0 (getvar 'cmdactive)) 
  ) 
      (if (= owner nil) 
  (vla-sendcommand 
    (vla-get-activedocument (vlax-get-acad-object)) 
    (strcat (rtos (car p) 2 3) "," (rtos (cadr p) 2 3) " HH ") 
  ) 
  (progn 
    (if (> (length owner) 2) 
      (setq ent (last (last owner))) 
      (setq ent (car owner)) 
    ) 
    (setq  b   (cdr (assoc 0 (entget ent))) 
    doc (vlax-get (vlax-get-acad-object) "activedocument") 
    ) 
    (if (wcmatch b "*TEXT,ATTDEF") 
      (progn (setq ent (vlax-ename->vla-object ent)) (if (> (setq color1 (vla-get-Color ent)) 5)(setq color1 0))(vla-put-Color ent (1+ color1))) 
    ) 
  ) 
      ) 
    ) 
  ) 
   
  (if dblclk-edit 
    (dblclk-edit point) 
  ) 
) 
;;;;;;;;;;;;;;;;;;;双击空白处执行HH命令;文本则变色

daidong013 · 发表于 2013-7-5 07:25:47

学习了，呵呵！

sjj · 发表于 2013-7-24 06:21:11

双击后文本颜色是会变色，但此时编缉的其它文本颜色不会变

账号		自动登录	找回密码
密码			立即注册

[求助] 求一个双击单行文本直接跳出对话框的lisp程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

点评

点评

点评

点评

点评

点评

评分