附件这个快速选择上次选择集的程序有时选不了，请高手们看看，能改的帮忙改一下！
;;;建立选择集----获取最后生成的图元选择集……程序一;;;支持COPY中途取消
;;;
;; LUCAS(龍龍仔)的 j.vlx 支持的命令集
;;("3DARRAY" "ARRAY" "-ARRAY" "BLOCK"
;; "-BLOCK" "BOUNDARY" "-BOUNDARY" "BREAK"
;; "COPY" "DTEXT" "EXPLODE" "INSERT"
;; "-INSERT" "LEADER" "LINE" "MIRROR"
;; "MIRROR3D" "OFFSET" "QDIM" "QLEADER"
;; "SKETCH" "SOLPROF" "TEXT" "-TEXT")
(DEFUN *just_ss* ()
(VL-LOAD-COM)
(SETQ *cmd_lst (LIST (LIST "3DARRAY")
(LIST "_3DARRAY")
(LIST "ARRAY")
(LIST "-ARRAY")
(LIST "_ARRAY")
(LIST "COPY")
(LIST "_COPY")
(LIST "EXPLODE")
(LIST "_EXPLODE")
(LIST "LINE")
(LIST "_LINE")
(LIST "OFFSET")
(LIST "_OFFSET")
(LIST "MIRROR")
(LIST "_MIRROR")
(LIST "MIRROR3D")
(LIST "_MIRROR3D")
(LIST "PASTECLIP")
(LIST "_PASTECLIP")
(LIST "PASTEBLOCK")
(LIST "_PASTEBLOCK")
(LIST "PASTEORIG")
(LIST "_PASTEORIG")
(LIST "PASTESPEC")
(LIST "_PASTESPEC")
) ;_ 监视的相关命令
)
(SETQ *cmdlst (MAPCAR 'STRCASE (MAPCAR 'CAR *cmd_lst)))
(MAPCAR '(LAMBDA (x) (VLR-COMMAND-REACTOR nil x)) ;_ 命令监视反应器
(LIST '((:VLR-COMMANDWILLSTART . cmd_start)) ;_ 命令开始时调用……
'((:VLR-COMMANDENDED . cmd_end)) ;_ 命令结束时调用……
'((:VLR-COMMANDCANCELLED . cmd_cancel)) ;_ 命令取消时调用……
)
)
(PRINC)
)
;;;
(DEFUN cmd_start (calling-reactor startinfo /) ;_ 命令开始时调用……
(FOREACH n *cmd_lst
(IF (= (STRCASE (CAR startinfo)) (STRCASE (CAR n))) ;_命令反应器返回信息如果与设置的命令相同
(ea:setmark)
)
)
)
;;;
(DEFUN cmd_end (calling-reactor endinfo / cmd) ;_ 命令结束时调用……
(SETQ cmd (CAR endinfo))
(IF (MEMBER cmd *cmdlst)
(ea:getss)
)
)
;;;
(DEFUN cmd_cancel (calling-reactor cancelinfo / cmd) ;_ 命令取消时调用……
(SETQ cmd (CAR cancelinfo))
;;(PRINC (= (STRCASE cmd) (STRCASE "copy")))
(IF (AND (MEMBER cmd *cmdlst)
(OR (= (STRCASE cmd) (STRCASE "COPY")) (= (STRCASE cmd) (STRCASE "_COPY")))
)
(ea:getss)
)
)
;;用于模型空间的设置标记及获取标记后实体
;;适用 CAD2000+ 以上版本
;;==============================================
;;程序思路：利用 entlast 实体的 ObjectID 作标记
;; 获取选择集时，由空间最后一个实体
;; 一个个往前找, 当实体的 ID 大于标
;; 记的 ID 时为新生成实体
;;==============================================
;;;设置标记
(DEFUN ea:setmark ()
(IF (ENTLAST)
(PROGN
(IF $yb_last_entity_mark
(SETQ $yb_last_entity_mark nil)
)
(SETQ $yb_last_entity_mark
(VLA-GET-OBJECTID
(VLAX-ENAME->VLA-OBJECT (ENTLAST))
)
)
)
)
(PRINC)
)
;;;获取标记后生成的实体
(DEFUN ea:getss (/ obj modelspace number) ;_ *get_xz_ss* 全局变量
(SETQ modelspace (VLA-GET-MODELSPACE (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
number (VLA-GET-COUNT modelspace) ;_当前空间实体总数量
)
(SETQ *get_xz_ss* (SSADD))
(IF $yb_last_entity_mark
(PROGN
(WHILE (> (VLA-GET-OBJECTID
(SETQ
obj (VLA-ITEM modelspace (1- number))
) ;_倒着数一个个来
)
$yb_last_entity_mark
)
(SSADD (VLAX-VLA-OBJECT->ENAME obj) *get_xz_ss*)
(SETQ number (1- number))
)
)
)
;;(SETQ $yb_last_entity_mark nil)
(IF (AND *get_xz_ss* (> (SSLENGTH *get_xz_ss*) 0))
(PROGN
*get_xz_ss*
;;(CDR (SSSETFIRST nil *get_xz_ss*)) ;_夹点显示
;;(PRINC (STRCAT "\n共有" (ITOA (SSLENGTH *get_xz_ss*)) "个物体被选择。"))
)
*get_xz_ss*
)
(PRINC)
)
(*just_ss*) ;_ 运行*just_ss*
(DEFUN c:jj () ;_ 该命令可以透明调用
(IF *get_xz_ss*
(PROGN
(IF (= 0 (GETVAR "cmdactive")) ;_ 系统变量判断
(CDR (SSSETFIRST nil *get_xz_ss*)) ;_夹点显示
) ;_ 结束if
) ;_ 结束progn
(PRINC "\n没有实体被选中。")
) ;_ 结束if
*get_xz_ss*
)
(PRINC)
自已顶一下。 自已顶一下。 选择上次cad本身就有吧。
页:
[1]