[求助]如何双击一个块，就执行一个指定的lisp程序？

clh521

比如，我双击一个“图框”的块，就运行一个我自已编的用来打印的lisp程序：dy.lsp

masterlong

根据以前论坛一个帖子改的
有自己的注释
改一下就可以满足你的要求

(defun c:sw()
 (load "双击测试.lsp")
(princ)
)

(defun jboadDoublClickReactor (/)
 (vl-load-com)
 ;0语句功能注释：：：创建鼠标双击反应器
 (if (/= (type jbDoubleClickReactor) 'VLR-Mouse-Reactor)
  (setq jbDoubleClickReactor  (VLR-Mouse-Reactor nil '((:VLR-beginDoubleClick . jb:beginDoubleClick))))
  vlr-editor-reactor
 )
 ;0语句功能注释：：：测试反应器是否已激活
 (if (not (vlr-added-p jbDoubleClickReactor))
  (vlr-add jbDoubleClickReactor)
 )
 ;0语句功能注释：：：卸载acdblclkedit.arx
 (if (member "acdblclkedit.arx" (arx)) (arxunload "acdblclkedit.arx" nil))
(princ)
)

(defun jb:beginDoubleClick ( reactorObject Listofsomething / point obj owner ownerobj command-list cmd gripset) ;;(princ "\n双击响应\n")
 (if (vl-catch-all-error-p (vl-catch-all-apply 'trans (list (car Listofsomething) 0 1)))
  (princ "PaperSpace")
  (progn
   (setq cmd "_.PROPERTIES" ; command default
    point Listofsomething
    obj (car (nentselp (trans (car point) 0 1)))
    owner (car (cadddr (nentselp (trans (car point) 0 1))))
    gripset (cadr (ssgetfirst))
    doc (vlax-get (vlax-get-acad-object) "activedocument")
   )

   (if obj
    (progn
     (cond
      (owner (setq ownerobj (strcase (vlax-get (vlax-ename->vla-object owner) "objectname"))))
      ( T (setq ownerobj (strcase (vlax-get (vlax-ename->vla-object obj) "objectname"))))
     )
     ;0《《这里是被我替换修改部分的位置》》
     ;1我的修改,便于修改设置
     (setq command-list (get-com-list))
     
     (foreach x command-list
      (if (= (car x) ownerobj)(setq cmd(cdr x)))
     )
  ;2这个位置我要进行替换，加入图块内容识别，重点在“3”
  ;|
     (cond
      ( (= cmd "_.REFEDIT") (princ "1图块  ") (setq cmd "_.refedit (princ (cdr (nentselp (trans(car point)0 1)))) ") )
      ( (= cmd "_.ATTEDIT") (princ "2属性块") (setq cmd "_.attedit (princ obj) ") )
      ( (= cmd "_.EATTEDIT")(princ "3属性块") (setq cmd "_.eattedit (princ obj) ") )
      ( T (setq cmd(strcat cmd " ")))
     )
  |;
  ;0000我想直接用command函数,不能用
     ;;(vla-sendcommand doc cmd)
     
;3以下是我替换的内容
(cond
;0----0----0图块或属性块，均经过识别后再分配新的程序
 ( (or (= cmd "_.REFEDIT")(= cmd "_.EATTEDIT")) (属性块识别) )
;4以下内容可用，主要用途在于：当选择图块或属性块的非属性部分时，调用“参照编辑程序”。
;4屏蔽的原因是，根据图块名称选择相应的程序。若开启这部分程序，需特殊处理的属性块必须选属性图元，不能选其它图元。
;|
 ( (= cmd "_.REFEDIT")             ;;;楼主需要改的就是这段代码
  ;;(princ "1图块  ")
  ;;(setq cmd "_.refedit (princ (cdr (nentselp (trans(car point)0 1)))) ")
  (setq cmd "_.refedit ")
  (vla-sendcommand doc cmd)
 )
|;
;|  不调用这个命令
 ( (= cmd "_.ATTEDIT")
  (princ "2属性块")
  (setq cmd "_.attedit (princ obj) ")
  (vla-sendcommand doc cmd)
 )
|;
 ( (= cmd "_.EATTEDIT")(属性块识别))  ;3替换的就是这一句
;4上一句不替换情况下的程序段
;|
 ( (= cmd "_.EATTEDIT")
  ;;(setq cmd "_.eattedit (princ obj) ")
  (setq cmd "_.eattedit ")
  (vla-sendcommand doc cmd)
 )
|;
 ( T (setq cmd (strcat cmd " ")) (vla-sendcommand doc cmd) )
)
    )
   )
  )
 )
(princ)
)

;0----0----0
;1属性块识别将生成一个全局参数，用来给属性块相应程序调用
;2该全局参数格式 ( 图元名 . 选取点 )
;3图元名是主图元
(defun 属性块识别( / a loop b b0)      ;;(princ "\n--属性块识别--\n")
 ;;(setq cmd "_.eattedit ")(vla-sendcommand doc cmd);;
 (cond
  ;9999 owner为T时，代表主图元
  ( owner (setq ##双击图块## (cons owner point)) )
  ;9999 owner为nil时，需要另外获取主图元
  ( T
   (setq b obj)
   (setq loop T)
   (while loop
    (setq b (entnext b))
    (setq c (entget b))
    (setq c0 (cdr (assoc 0 c)))
    (if (= c0 "SEQEND")
     (setq cf2 (cdr (assoc -2 c)) loop Nil)
    )
   )
   (setq ##双击图块## (cons cf2 point))
  )
 )
 (princ "\n")(princ (setq blkname (cdr (assoc 2 (entget (car ##双击图块##))))))(princ "\n")
 (cond
  ( (wcmatch blkname "QGY_TK-*")
   (princ "轻工院图框....启动图框编辑器....")(princ "\n")
   (redraw (car ##双击图块##) 4)
   (setq ##QGYTK_obj## ##双击图块##)  ;;临时设置
   (vla-sendcommand doc "##vf ")
  )
  ;;( () () )
  ;;( () () )
  ( T
   (setq ##双击图块## Nil)
   (cond
    ( (= cmd "_.REFEDIT" )(setq cmd "_.refedit ")  (vla-sendcommand doc cmd) )
    ( (= cmd "_.EATTEDIT")(setq cmd "_.eattedit ") (vla-sendcommand doc cmd) )
   )
  )
 )
 ;;(princ "主图元=")(princ ##双击图块##)
(princ)
)

;3我的修改
(defun get-com-list(/ infile infp inf)          ;;(princ "\n--get-com-list--\n")
 (setq infile  (open "D:\\@@_new_lisp\\双击设置.no" "r") )
 (setq infp '() )
 (while (setq inf (read-line infile) )
  (setq inf (read inf) )
  (setq infp (cons inf infp) )
 )
 (close infile)
 (reverse infp)
)
;4我的修改
;|
双击设置.no  为文本文件
放于CAD主程序根目录
文件格式如下
("ACDBBLOCKREFERENCE" . "_.REFEDIT")  图块
("ACDBATTRIBUTE" . "_.ATTEDIT")   块属性
|;

;0被我修改替换掉的部分
;|  
  (setq command-list
   (list
    (cons "ACDBBLOCKREFERENCE" "_.REFEDIT")
    (cons "ACDBATTRIBUTE" "_.ATTEDIT")   ;;调用这个命令比较好，EATTEDIT
    (cons "ACDBMTEXT" "_.DDEDIT")
    (cons "ACDBTEXT" "_.DDEDIT")
    (cons "ACDBROTATEDDIMENSION" "_.DDEDIT")
    (cons "ACDBALIGNEDDIMENSION" "_.DDEDIT")
    (cons "ACDBORDINATEDIMENSION" "_.DDEDIT")
    (cons "ACDBDIAMETRICDIMENSION" "_.DDEDIT")
    (cons "ACDBRADIALDIMENSION" "_.DDEDIT")
    (cons "ACDB2LINEANGULARDIMENSION" "_.DDEDIT")
    (cons "ACDBMLINE" "_.MLEDIT")
    (cons "ACDBATTRIBUTEDEFINITION" "_.DDEDIT")
    (cons "ACDBHATCH" "_.HATCHEDIT")
    (cons "ACDBRASTERIMAGE" "_.IMAGEADJUST")
    (cons "AECDBWALL" "_.PROPERTIES")
    (cons "AECDBDOOR" "_.PROPERTYDATAEDIT")
    (cons "AECDBWINDOW" "_.PROPERTIES")
    (cons "AECDBWINDOWASSEMBLY" "_.PROPERTIES")
    (cons "AECDBCURTAINWALLLAYOUT" "_.PROPERTIES")
    (cons "AECDBSPACE" "_.PROPERTYDATAEDIT")
    (cons "AECDBSTAIR" "_.PROPERTIES")
    (cons "AECDBRAILING" "_.PROPERTIES")
    (cons "AECDBMVBLOCKREF" "_.PROPERTIES")
    (cons "AECDBOPENING" "_.PROPERTIES")
    (cons "AECDBCEILINGGRID" "_.PROPERTIES")
    (cons "AECDBCOLUMNGRID" "_.PROPERTIES")
    (cons "AECDBSLAB" "_.PROPERTIES")
    (cons "AECSDBMEMBER" "_.PROPERTIES")
    (cons "AECDBMASSELEM" "_.PROPERTIES")
    (cons "AECDBROOF" "_.PROPERTIES")
    (cons "AECDBROOFSLAB" "_.PROPERTIES")
    (cons "AECDBCAMERA" "_.PROPERTIES")
    (cons "AECDBSCHEDULETABLE" "_.PROPERTIES")
   )
  )
|;

;;(progn (jboadDoublClickReactor) (princ))

;;;;;--------------------------------------------------------
;;;双击设置.no
("ACDBBLOCKREFERENCE" . "_.REFEDIT")
("ACDBATTRIBUTE" . "_.EATTEDIT")
("ACDBMTEXT" . "_.DDEDIT")
("ACDBTEXT" . "_.DDEDIT")
("ACDBROTATEDDIMENSION" . "_.DDEDIT")
("ACDBALIGNEDDIMENSION" . "_.DDEDIT")
("ACDBORDINATEDIMENSION" . "_.DDEDIT")
("ACDBDIAMETRICDIMENSION" . "_.DDEDIT")
("ACDBRADIALDIMENSION" . "_.DDEDIT")
("ACDB2LINEANGULARDIMENSION" . "_.DDEDIT")
("ACDBMLINE" . "_.MLEDIT")
("ACDBATTRIBUTEDEFINITION" . "_.DDEDIT")
("ACDBHATCH" . "_.HATCHEDIT")
("ACDBRASTERIMAGE" . "_.IMAGEADJUST")
("AECDBWALL" . "_.PROPERTIES")
("AECDBDOOR" . "_.PROPERTYDATAEDIT")
("AECDBWINDOW" . "_.PROPERTIES")
("AECDBWINDOWASSEMBLY" . "_.PROPERTIES")
("AECDBCURTAINWALLLAYOUT" . "_.PROPERTIES")
("AECDBSPACE" . "_.PROPERTYDATAEDIT")
("AECDBSTAIR" . "_.PROPERTIES")
("AECDBRAILING" . "_.PROPERTIES")
("AECDBMVBLOCKREF" . "_.PROPERTIES")
("AECDBOPENING" . "_.PROPERTIES")
("AECDBCEILINGGRID" . "_.PROPERTIES")
("AECDBCOLUMNGRID" . "_.PROPERTIES")
("AECDBSLAB" . "_.PROPERTIES")
("AECSDBMEMBER" . "_.PROPERTIES")
("AECDBMASSELEM" . "_.PROPERTIES")
("AECDBROOF" . "_.PROPERTIES")
("AECDBROOFSLAB" . "_.PROPERTIES")
("AECDBCAMERA" . "_.PROPERTIES")

clh521

具体怎么改？能不能帮忙改下，反应器我一不懂啊

masterlong

修改的部分不涉及反应器的知识

提取出图块名后判别是否图框块

是的话再判别块是否斜角度

否的话提取块的包围盒两对角坐标和比例

其余的就是打印设置的问题了

自己先研究下吧

实在不行再帮你改好了

hb_xiaofen

回复一下保存下来有时间学学

h008

好好学习下！

宏远电脑学校

CAD2008  打开“工具”“自定义”“界面”里面有双击块设置，默认是宏，你设成LISP函数名就行了，比如：定义（defun c:test()，就填上test就行了，记得加载LISP程序哦。

mmh1

只听说反应器，还没涉及！观望学习下

我爱lisp

(vl-load-com)
(if (not (tblsearch "layer" "HATCH"))
  (command "-layer" "m"        "HATCH"        "c" "254" "" "l" "continuous" "" "")
)                                        ;加载图层HATCH
(if (not *dblclkReactor*)
  (setq        *dblclkReactor*
         (VLR-Mouse-Reactor
           nil
           '((:VLR-beginDoubleClick . dblclkedit))
         )
  )
)                                        ;0 = 打开反应器
(defun dblclkedit (reactorObject point)
  (if dblclk-edit
    (dblclk-edit point)
  )
)
(defun dblclk-edit (dblclk_point / owner dblclk_etype p)
  (setq owner (nentselp (setq p (trans (car dblclk_point) 0 1))))
                                        ;指定点来选择对象
  (if (and (= owner nil) (= 0 (getvar 'cmdactive))) ;_有活动命令时不起作用
    (vla-sendcommand
      (vla-get-activedocument (vlax-get-acad-object))
      (strcat (rtos (car p) 2 3)
              ","
              (rtos (cadr p) 2 3)
              " tianc "
      )
    )
  )
)
(defun c:tianc (/ opt pt la)
  (setvar "measurement" 1)
  (setq        opt
         (mycadgetkword
           "\n①实体/②钢筋砼/③素砼/④墙体/⑤阳台/⑥卫生间/⑦厨房：<1>"
           '("1" "2" "3" "4" "5" "6" "7")
           "1"
         )
  )
  (cond
    ((= opt "1") (tianchong1))
    ((= opt "2") (tianchong2))
    ((= opt "3") (tianchong3))
    ((= opt "4") (tianchong4))
    ((= opt "5") (tianchong5))
    ((= opt "6") (tianchong6))
    ((= opt "7") (tianchong7))
  )
  (princ)
)

(defun tianchong1 ()
  (prompt "\n实体填充,指定内部点\n")
  (setq la (getvar "clayer"))
  (command "layer" "s" "hatch" "")
  (while (setq pt (getpoint))
    (command "bhatch" "p" "solid" pt "")
  )
  (setvar "clayer" la)
)                                        ;solid连续填充,指定内部点

(defun tianchong2 ()
  (prompt "\n钢筋砼填充,指定内部点\n")
  (setq la (getvar "clayer"))
  (command "layer" "s" "hatch" "")
  (while (setq pt (getpoint))
    (command "bhatch" "p" "ar-conc" "4" "0" pt "")
    (command "bhatch" "p" "ansi31" "160" "0" "@" "")
  )
  (setvar "clayer" la)
)                                        ;ar-conc&ansi31连续填充,指定内部点

(defun tianchong3 ()
  (prompt "\n素砼填充,指定内部点\n")
  (setq la (getvar "clayer"))
  (command "layer" "s" "hatch" "")
  (while (setq pt (getpoint))
    (command "bhatch" "p" "ar-conc" "4" "0" pt "")
  )
  (setvar "clayer" la)
)                                        ;ar-conc连续填充,指定内部点

(defun tianchong4 ()
  (prompt "\n墙体填充,指定内部点\n")
  (setq la (getvar "clayer"))
  (command "layer" "s" "hatch" "")
  (while (setq pt (getpoint))
    (command "bhatch" "p" "ansi31" "60" "0" pt "")
  )
  (setvar "clayer" la)
)                                        ;ansi31连续填充,指定内部点

(defun tianchong5 ()
  (prompt "\n阳台填充,指定内部点\n")
  (setq la (getvar "clayer"))
  (command "layer" "s" "hatch" "")
  (while (setq pt (getpoint))
    (command "bhatch" "p" "ansi37" "60" "0" pt "")
  )
  (setvar "clayer" la)
)                                        ;ansi37连续填充,指定内部点

(defun tianchong6 ()
  (prompt "\n卫生间填充,指定内部点\n")
  (setq la (getvar "clayer"))
  (command "layer" "s" "hatch" "")
  (while (setq pt (getpoint))
    (command "bhatch" "p" "cross" "30" "0" pt "")
  )
  (setvar "clayer" la)
)                                        ;cross连续填充,指定内部点

(defun tianchong7 ()
  (prompt "\n厨房填充,指定内部点\n")
  (setq la (getvar "clayer"))
  (command "layer" "s" "hatch" "")
  (while (setq pt (getpoint))
    (command "bhatch" "p" "angle" "30" "0" pt "")
  )
  (setvar "clayer" la)
)                                        ;angle连续填充,指定内部点
(princ)

(defun MycadGetkword (pro lst def / kw val)
  (setq        lst (apply
              'append
              (mapcar '(lambda (e)
                         (list (ascii (strcase e)) (ascii (strcase e T)))
                       )
                      lst
              )
            )
        def (ascii def)
  )
  (prompt pro)
  (while (not (and (setq kw  (grread nil)
                         val (car kw)
                         kw  (cadr kw)
                   )
                   (member val '(2 11 25))
                   (if (or (= val 25)
                           (and (= val 11) (= kw 0))
                           (member kw '(13 32))
                       )
                     (setq kw def)
                     (member kw lst)
                   )
              )
         )
  )
  (strcase (vl-list->string (list kw)))
)

我爱lisp

这个双击反应器可以直接运行，你可以慢慢研究，看看如何修改