[LISP程序]能一次选取COPY出来的对象[原创]

龙龙仔 · 发表于 2002-2-27 12:36:00

;;; FOR AutoCAD 2000 以上
;;; 因AUTOCAD只有"L" & "

"可供选取使用
;;; 'K (通透指令)能一次选取 COPY  出来的对象
;;; 'KK  (通透指令)能一次选取 MIRROR 出来的对象
;;; 'KKK (通透指令)能一次选取 ARRAY 出来的件
;;; 程序设计:赖云龙
;;;----------------------------------------------------------------------;;;

(defun MARK_COMMANDWILLSTART (CALLING-REACTOR COMMANDINFO / INFO)
  (setq INFO (car COMMANDINFO))
  (if (or (= "COPY" INFO)
   (= "MIRROR" INFO)
   (= "ARRAY" INFO)
   (= "-ARRAY" INFO)
   )
(setq *MARK_SS* (entlast))
  )
)

(defun DO_IT (/ LLL SS)
  (setq SS (ssadd))
  (ssadd (entlast) SS)
  (setq LLL (entnext *MARK_SS*))
  (while (not (eq LLL (entlast)))
(ssadd LLL SS)
(setq LLL (entnext LLL))
  )
  SS
)

(defun MARK_COMMANDENDED (CALLING-REACTOR COMMANDINFO / INFO)
  (setq INFO (car COMMANDINFO))
  (cond
((= "COPY" INFO)
   (setq *COPY_SS* (DO_IT))
)
((= "MIRROR" INFO)
   (setq *MIRROR_SS* (DO_IT))
)
((or (= "ARRAY" INFO) (= "-ARRAY" INFO))
   (setq *ARRAY_SS* (DO_IT))
)
  )
)

(defun C:K ()
  (setq *COPY_SS* *COPY_SS*)
)

(defun C:KK ()
  (setq *MIRROR_SS* *MIRROR_SS*)
)

(defun C:KKK ()
  (setq *ARRAY_SS* *ARRAY_SS*)
)

(defun C:COMMANDREACTOR ()
  (vl-load-com)
  (if (not *COMMANDENDED_REACTOR*)
(setq *COMMANDENDED_REACTOR*
   (vlr-editor-reactor
      NIL
      '((:vlr-commandended . MARK_COMMANDENDED))
   )
)
  )
  (if (not *COMMANDWILLSTART_REACTOR*)
(setq *COMMANDWILLSTART_REACTOR*
   (vlr-editor-reactor
      NIL
      '((:vlr-commandwillstart . MARK_COMMANDWILLSTART))
   )
)
  )
  (if (not *DRAWINGREACTOR*)
(setq *DRAWINGREACTOR*
   (vlr-dwg-reactor
      NIL
      '((:vlr-beginclose . CLEANREACTORS)
      )
   )
)
  )
)

(defun CLEANREACTORS ()  ;;取消反应器
  (mapcar 'vlr-remove-all
   '(:vlr-dwg-reactor
      :vlr-editor-reactor
   )
  )
)

(C:COMMANDREACTOR)
(princ)

;|(defun C:REMOVEREACTOR ()  ;;取消反应器
  (mapcar 'vlr-remove
   '(*COMMANDENDED_REACTOR*
      *COMMANDWILLSTART_REACTOR*
      *DRAWINGTREACTOR*
   )
  )
)|;

QUAN2518 · 发表于 2008-8-8 20:37:00

这个贴不错

把他挖出来给大家看看

就是只有几个AutoCAD命令才可以使用自己写的LSP不能用他来选物.

龙大哥来完善下

caoyin · 发表于 2008-8-9 09:16:00

好贴，支持！！

龙龙仔 · 发表于 2008-8-11 07:57:00

那是多年前j程序的原始構想程序(很多缺點)

liminnet · 发表于 2008-8-11 08:34:00

提示: 作者被禁止或删除内容自动屏蔽

QUAN2518 · 发表于 2008-8-11 23:44:00

那就把你现在用的没什么缺点的那来大家共享一下啊.

jxlsp · 发表于 2008-8-12 13:05:00

看不懂.

byghbcx · 发表于 2008-8-13 09:35:00

不用反应器也可以做到

;返回copy mirror后的实体
;Desgined by byghbcx 2008.08.13
(defun C:k( / ss0 len e ss e sn ss1 n k)
(setq ss0 (ssget "p"))
(if ss0
(progn
(setq len (sslength ss0))
(setq e (ssname ss0 (1- len)))
(SETQ SS (SSADD))
(WHILE E
(SETQ E (ENTNEXT E))
(IF E
(PROGN
(SETQ SN (CDR (ASSOC 0 (ENTGET E))))
(IF (NOT (MEMBER SN (quote ("ATTRIB" "VERTEX" "SEQEND"))))
(SETQ SS (SSADD E SS))
)
)
)
)
)
)
(if ss
(progn
(setq ss1 (ssadd) n (sslength ss) k 1)
(repeat len
(setq ss1 (ssadd (ssname ss (- n k)) ss1) k (1+ k))
)
)
)
ss1
)

jxlsp · 发表于 2008-8-13 13:32:00

byghbcx发表于2008-8-13 9:35:00不用反应器也可以做到;返回copy mirror后的实体;Desgined by byghbcx 2008.08.13(defun C:k( / ss0 len e ss e sn ss1 n k) (setq ss0 (ssget \"p\")) (if ss0 (progn

请问下,哪一句是判断对象是复制的? (setq ss0 (ssget "p"))吗?

byghbcx · 发表于 2008-8-13 16:50:00

请问下,哪一句是判断对象是复制的? (setq ss0 (ssget "p"))吗?

此程序没有判断对象是否被复制,要加判断也可以

可以在复制过以后,运行K命令,也可以透明使用.

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

liminnet liminnet 当前离线积分 9754 明经币个注册时间 2007-8-22 在线时间小时威望金钱个贡献激情	发表于 2008-8-11 08:34:00 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡