明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1301|回复: 1

删除重复块高程--修改明经某位大侠程序

[复制链接]
发表于 2015-8-27 19:35:01 | 显示全部楼层 |阅读模式

  1. ;选择集与对象名表互转
  2. (defun cx-ss2en
  3.   (ss / enlst)
  4.   (cond
  5.     ((= (type ss) 'PICKSET)
  6.       (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
  7.     )
  8.     ((= (type ss) 'LIST)
  9.       (setq enlst (ssadd))
  10.       (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
  11.     )
  12.     ((='ename(type ss))
  13.       (ssadd ss)
  14.     )
  15.   )
  16. )





  17. ;货物分两组(样品 库存)
  18. (defun lst->2lst(lst / lst1 lst2)
  19.   (setq lst1 '() lst2 '())
  20. (foreach a lst
  21.     (if (member a lst2)
  22.       (setq lst1 (cons a lst1))
  23.       (setq lst2 (cons a lst2))
  24.     )
  25.   )
  26. (cons (reverse lst2) (reverse lst1))
  27. )
  28. ;检查重叠块
  29. (defun c:chk_blocks (/ ss pt s1 dxf2 dxf41 dxf50 ss1 i)
  30.   (setq ss (ssget '((0 . "insert")))
  31.        i  0
  32.        )
  33.   (if (and ss (> (sslength ss) 2))
  34.    (progn
  35.     (setq entlst (cx-ss2en ss)
  36.           ptlst (mapcar '(lambda(x) (assoc 10(entget x))) entlst)
  37.           2ptlst (lst->2lst ptlst)
  38.           )
  39.      (if (cdr 2ptlst)
  40.        (progn
  41.          ;(setq pt (getpoint "引出点:"))
  42.          (foreach x (cdr 2ptlst)
  43.            ;(entmake (list '(0 . "line") '(8 . "0-辅助层tem") (cons 62 1) x (cons 11 pt)))
  44. (repeat (setq k (length (cdr 2ptlst)))
  45.     (if  (and (setq e (ssname ss (setq k (1- k ))))
  46.        (setq en (entget e))
  47.   )
  48.       (progn  
  49.   
  50.   (if (member x en)
  51.     (entdel e)
  52.     ;(setq en (cons x en))
  53.   )
  54.       )
  55.     )
  56.   )


  57.            
  58.            
  59.            )
  60.          )
  61.          (alert "报告老大,没有找到重叠块!")
  62.      )
  63.     )
  64.     (alert "老大,这么简单的问题自己解决!")
  65.    )
  66.    (princ)
  67. )



  68. ;;156.1 [功能] 删除重叠对象(overkill)
  69. ;;不知谁写的,太好了.
  70. (DEFUN HH:delBLOCKs (ss / E EN K LIST1 S9 XY)
  71.   (repeat (setq k (sslength ss))
  72.     (if  (and (setq e (ssname ss (setq k (1- k ))))
  73.        (setq en (entget e))
  74.   )
  75.       (progn  
  76.   (setq xy (cdr en))
  77.   (IF (SETQ S9 (ASSOC 5 XY))
  78.     (SETQ XY (subst '(5 . "ASD") S9 XY))
  79.   )
  80.   (if (member xy list1)
  81.     (entdel e)
  82.     (setq list1 (cons xy list1))
  83.   )
  84.       )
  85.     )
  86.   )
  87. )
发表于 2015-8-27 20:27:34 | 显示全部楼层
还是写明出处与作者比较好
部分应是来之于77077
http://bbs.mjtd.com/thread-113683-1-1.html

HH开头的函数应该是黄老的
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-6 03:54 , Processed in 0.165928 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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