明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2784|回复: 12

[资源] 找到一个狂刀的拷贝块内实体程序

[复制链接]
发表于 2014-10-22 16:28 | 显示全部楼层 |阅读模式
本帖最后由 42142 于 2014-10-22 16:36 编辑


;放在这里,希望作者不要生气
;| blkssc,knkb (拷贝块内实体)----by lxx.2007.12
函数 c:blkssc 或 c:knkb (块内拷贝)
功能: 1.点选要编辑的块,自动亮显块内实体
      2.选择要删除的块内实体(支持框选)。选中后取消亮显,再次选择恢复亮显(亮显的即块内实体)
      3.回车或空选退出编辑状态
      4.已设出错处理,中途退出恢复编辑前状态.
|;
(defun c:knkb ()(c:blkssc)) ;; knsc = 块内删除.
(defun c:blkssc (/ *ERROR* *MYERR BLKN E EEE NPT OLDERR PAUSE SS SS2 SSB SSN SSR SSS SSS2 X ssx)
  (princ "\n knkb=拷贝块内实体   by lxx.2008.2")
  (defun *myerr (msg)(if sss2 (progn(command ".undo" "e")(command ".u")))(setq *error* olderr)(princ))
  (setq olderr *error*
*error* *myerr)
  (princ "\n 选择要局部拷贝的块(可多选):")
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (setq e  (ssname ss 0)
     blkn (cdr (assoc 2 (entget e)))
      )
      (command ".undo" "be")
      (setvar "qaflags" 1)
      (command ".explode" ss "")
      (setq ss2 (ssget "p"))
      (setq sss2 (xss2lst ss2))
      (mapcar '(lambda (x) (redraw x 3)) sss2)
      (princ "\n 选择要拷贝的块内实体,亮显为块内保留实体:")
      (while (setq ssa (ssget ":S"))
(mapcar '(lambda (x)
     (if (and (ssmemb x ss2) (member x ssr))
       (progn (redraw x 3)
       (setq ssr (vl-remove x ssr))
       )
       (if (ssmemb x ss2)
         (progn (redraw x 4)
         (setq ssr (cons x ssr))
         )
       )
     )
   )
  (xss2lst ssa)
)
      )
      (setq ssx (mapcar 'entget ssr))
      (command ".u")
;;;      (setq ;npt (getpoint "\n 拷贝基点:")
;;;     ;npt2 (getpoint "\n 拷贝到:")
;;;     )
      (setq eee (entlast)
     ssn (ssadd))
      (mapcar 'entmake ssx)
;;;      (setq eee(entnext eee))
      (while (setq eee(entnext eee))
(ssadd eee ssn)
      )
;;;      (command ".move" ssn "" npt pause)
;;;      (setq rlst (mapcar '(lambda (x) (vl-position x sss2)) ssr))
;;;      (setq i -1)
;;;      (vlax-for x (vla-item
;;;      (vla-get-blocks
;;;        (vla-get-activedocument (vlax-get-acad-object))
;;;      )
;;;      blkn
;;;    )
;;; (setq i (1+ i))
;;; (if (member i rlst)
;;;   (vla-delete x)
;;; )
;;;      )
;;;      (setq ssb (ssget "x" (list (cons 0 "INSERT") (cons 2 blkn)))
;;;     sssb (xss2lst ssb)
;;;      )
;;;      (mapcar 'entupd sssb)
      (command ".undo" "e")
;;;      ssb
      
    )
  )
  (if ssn
    ;(sssetfirst ssn ssn)
    (command ".move" ssn "")
    )
)
;; v1.1
(defun xss2lst (ss / i lst)
  (setq i (sslength ss))
  (repeat i
    (setq lst (cons (ssname ss (setq i (1- i))) lst))
  )
)

(princ "\n knkb=拷贝块内实体   by lxx.2008.2")

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2020-2-1 19:35 | 显示全部楼层

感谢分享程序!
发表于 2014-10-22 17:39 | 显示全部楼层
果然不错...
发表于 2014-10-22 17:55 | 显示全部楼层
感谢分享程序!
发表于 2014-10-22 20:03 | 显示全部楼层
(defun c:knkb ()(c:blkssc) (setvar "qaflags" 0)) ;; knsc = 块内删除.

主命令须换成这个,把变量还原,不然会对一些人造成很大的麻烦的哦。另外这个使用时有一个小BUG,就是有时会把原块给全炸开了,这也是这个qaflags变量闹的,但这里提块里面的东西又不得不用它,所以看哪位有时间的童鞋修正一下就好了。总体来说,这个程序思路还是不错的。
发表于 2014-10-23 07:23 | 显示全部楼层
我感觉其实就是炸块,
发表于 2014-10-26 20:51 | 显示全部楼层
实质就是把块炸开。不过 确实是个好办法
发表于 2014-10-30 22:58 | 显示全部楼层
真好用,但老有BUG.会把原来的块炸开,这样就得不得不偿失了
发表于 2014-10-30 23:12 | 显示全部楼层
本帖最后由 hooboxu 于 2014-10-30 23:13 编辑

哦.不好意思不是炸开,中途取消后应该是留着原地了.误以为是炸开的.再试用看看.
还有想提个建议,能不能把亮显的改是不复制出来的. 亮显的是复制出来.感觉好像没被选中的反被复制了,有点不习惯啊.有没有同感的人呢?

谢谢分享.好赞
发表于 2014-10-30 23:16 | 显示全部楼层
还是有BUG..原块会炸散.不太稳定,求修复
发表于 2014-12-6 22:51 | 显示全部楼层
不是很稳定啊
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 23:49 , Processed in 0.192133 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表