另类拷贝AnotherCopy

/db_自贡黄明儒_ · 发表于 2013-6-24 13:33:16

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

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

×

本帖最后由牢固于 2013-6-24 13:40 编辑

看到wowan1314整得很热闹，我也凑一凑
自己觉得还是较实用的
{:soso_e138:}
谁在砸我头，轻点!

;;---------------------------------另类拷贝AnotherCopy
;; 末尾数字+1 自贡黄明儒
;;ayEntSSHighLight见http://www.xdcad.net/forum/thread-668461-1-1.html
;;SA_change就是10楼的w1或者w2了
(defun C:AC (/ P0 SS0)
;;2 对象na之后所有实体产生的选择集
(defun newsel (na / ss e1)
(if na
(setq na (entnext na))
(setq na (entnext))
)
(setq ss (ssadd))
(while na
(setq e1 (entget na))
(if (wcmatch (LI_item 0 e1) "VERTEX,SEQEND,ATTRIB")
nil
(setq ss (ssadd na ss))
)
(setq na (entnext na))
)
ss
)
;;3 copy
(defun do-copy (ss0 p0 / A BOOL PT SS SS1 SS2)
(setq bool T)
(setq ss ss0
pt p0
)
(while bool
(setq a (entlast))
(princ "\n >>下一点或者输入距离:")
(command "_.copy" ss "" pt pause)
(setq ss1 (newsel a))
(ayEntSSHighLight ss)
(command "._Select" ss1 "")
(if (setq ss2 (ssget "_p" '((0 . "*TEXT,ATTDEF,INSERT"))))
(SA_change ss2)
)
(if (equal pt (setq pt (getvar "lastpoint")) 0.001)
(progn (command "undo" "2") (setq bool nil))
)
(setq ss ss1)
;;(princ (getvar 'errno))
)
)
;;4 主程序
(command "undo" "be")
(if (and (setq ss0 (ssget))
(setq p0 (getpoint "\n >基点:"))
)
(do-copy ss0 p0)
)
(command "undo" "e")
(princ)
)
;;---------------------------------另类拷贝AnotherCopy

;;---------------------------------另类拷贝AnotherCopy 
;; 末尾数字+1 自贡黄明儒 
;;ayEntSSHighLight见<a href=\"http://www.xdcad.net/forum/thread-668461-1-1.html\" target=\"_blank\">http://www.xdcad.net/forum/thread-668461-1-1.html</a> 
;;SA_change就是10楼的w1或者w2了 
(defun C:AC (/ P0 SS0)   
  ;;2  对象na之后所有实体产生的选择集 
  (defun newsel        (na / ss e1) 
    (if        na 
      (setq na (entnext na)) 
      (setq na (entnext)) 
    ) 
    (setq ss (ssadd)) 
    (while na 
      (setq e1 (entget na)) 
      (if (wcmatch (LI_item 0 e1) "VERTEX,SEQEND,ATTRIB") 
        nil 
        (setq ss (ssadd na ss)) 
      ) 
      (setq na (entnext na)) 
    ) 
    ss 
  ) 
  ;;3  copy 
  (defun do-copy (ss0 p0 / A BOOL PT SS SS1 SS2) 
    (setq bool T) 
    (setq ss ss0 
          pt p0 
    ) 
    (while bool 
      (setq a (entlast)) 
      (princ "\n >>下一点或者输入距离:") 
      (command "_.copy" ss "" pt pause) 
      (setq ss1 (newsel a)) 
      (ayEntSSHighLight ss) 
      (command "._Select" ss1 "") 
      (if (setq ss2 (ssget "_p" '((0 . "*TEXT,ATTDEF,INSERT")))) 
        (SA_change ss2) 
      ) 
      (if (equal pt (setq pt (getvar "lastpoint")) 0.001) 
        (progn (command "undo" "2") (setq bool nil)) 
      ) 
      (setq ss ss1) 
      ;;(princ (getvar 'errno)) 
    ) 
  ) 
  ;;4  主程序 
  (command "undo" "be") 
  (if (and (setq ss0 (ssget)) 
           (setq p0 (getpoint "\n >基点:")) 
      ) 
    (do-copy ss0 p0) 
  ) 
  (command "undo" "e") 
  (princ) 
) 
;;---------------------------------另类拷贝AnotherCopy

st788796 · 发表于 2013-6-24 14:13:22

赞一个，抢到沙发了:lol

qianzj · 发表于 2013-6-24 15:25:40

LI_item 没提供。。

HLCAD · 发表于 2013-6-24 15:30:02

我支持黄大侠！

lgttblue · 发表于 2013-6-24 21:45:05

强烈支持:lol

phoevana · 发表于 2013-6-25 08:06:55

黄大，这个另类在哪啊，我没用出来，:(

sicky111 · 发表于 2013-6-25 09:08:12

都是高手。

dadiwusheng · 发表于 2016-3-30 03:26:08

谢谢分享！

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

[原创] 另类拷贝AnotherCopy

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

评分

点评

点评

点评