后天就是新年了，祝大家新年快乐，牛年更牛。
新年快乐!
新年快乐!
Happy 牛 year!!
本帖最后由 作者 于 2009-1-20 13:32:09 编辑
我来晚了，我先占个座位，等空了也发一下我的函数！
;;隐藏/显示选择集中的图元实体
;;参数：ss----选择集；code----显示/隐藏开关，值为0时，所有选择集中的图元实体隐藏不显示，值为1时，恢复显示选择集中的图元实体。
(defun ss_visible (ss code / na e1 n)
(if ss
(progn
(setq n 0)
(repeat (sslength ss)
(setq na (ssname ss n)
e1 (entget na)
) ;setq
(if (not (assoc 60 e1))
(setq e1 (append e1 (list (cons 60 code)))) ;setq then
(setq e1 (subst (cons 60 code) (assoc 60 e1) e1)) ;setq else
) ;if
(entmod e1)
(entupd na)
(setq n (+ n 1));setq
) ;repeat
) ;progn
) ;if
)
<p>桩孔自动编号、勘察自动编号、生成剖面及桩长统计程序（免费申请2009全功能版）<br/>自动生成EXCEL统计表格<br/> 自动生成剖面<br/> 勘察cad编号<br/> 桩孔CAD编号<br/>桩孔编号程序（2009版，免费申请全功能）<br/><br/> <br/> 下载地址：<a href="http://sckcy.ys168.com/" target="_blank"><font color="#0556d0">HTTP://SCKCY.YS168.COM</font></a><br/>免费赠送100个正式版，欲申请从速。</p>
偶也来占个位置
;单显图层程序zhuquanmao 20090120 上传 也许有用
(defun c:dxtc (/ a mumer tysm tysm tyl sjl tcl zqm chklay)
(command "layer" "on" "*" "")
(prompt "\n单显图层程序，请点取要打开的图层:")
(setq a (ssget))
(if (not a)
(command "layer" "on" "*" "" "")
(progn
(command "layer" "off" "*" "y" "")
(setq mumer 0)
(setq tysm (sslength a))
(repeat tysm
(setq ty1 (ssname a mumer))
(setq sj1 (entget ty1))
(setq tc1 (cdr (assoc 8 sj1)))
(command "layer" "on" tc1 "")
(command "layer" "on" (strcat (cdr (assoc 8 sj1)) "*") "")
(setq mumer (1+ mumer))
)
)
)
(princ)
)
祝大家春节快乐!身体健康!
本帖最后由 作者 于 2009-2-4 21:25:47 编辑
caoyin发表于2008-12-6 13:23:00static/image/common/back.gif;;选择对象 entsel ssget等 函数扩展;; by caoyin @mjtd.com;;____________________________________________________________________________________________________;; ▓ (lt:entsel msg ;;____________________________________________________________________________________________________
;; ▓ (lt:ssget-for msg flt fun)
;; [功能] 获取选择集并实时进行指定函数的操作
;; [参数] msg---提示信息(STR)，如果nil时则显示缺省为"\n选择对象: "
;; flt---等同于 ssget 函数图元过滤表
;; fun---要对所选对象执行的函数
;; [返回] 成功->选择集，反之->nil
;| [测试]
(lt:ssget-for "\n删除对象:" nil 'entdel)
(defun c:tt ()
(lt:ssget-for "选择要改变颜色的直线:"
'((0 . "line"))
'(lambda (x)
(if (or (>= col 256) (not col)) (setq col 0))
(vla-put-color (vlax-ename->vla-object x) (setq col (1+ col)))
)
)
)
|;
(defun lt:ssget-for (msg flt fun / cme nom sp ss ss2 e)
(setq cme (getvar "cmdecho")
nom (getvar "nomutt")
)
(if msg
(setq msg (strcat "\r" msg))
(setq msg "\r选择对象: ")
)
(setvar "nomutt" 1)
(setvar "cmdecho" 0)
(while
(progn
(setq sp (ssget "_P"))
(princ msg)
(command "_.select" "_si")
(command pause)
(setq ss (ssget "_p"))
(if (and sp (equal (ssnamex sp) (ssnamex ss)))
(setq ss nil)
)
ss
)
(if (and ss (setq ss (ssget "_p" flt)))
(progn
(if (not ss2) (setq ss2 (ssadd)))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(if fun (apply fun (list e)))
(ssadd e ss2)
)
)
)
)
(setvar "cmdecho" cme)
(setvar "nomutt" nom)
ss2
)
;;下面一个函数源自 xdcad.net 网友 讨论，龙版主发过，为了方便整理，放于此处
;;____________________________________________________________________________________________________
;; ▓ (lt:ssget lst)
;; [功能] 获取选择集(类似于 ssget 函数，不同的是可以加入提示信息)
;; [参数] lst----(LIST)参数列表，包含若干元素：
;; 第一个元素----提示信息(STR)，如果nil时则显示缺省为"\n选择对象: "
;; 其他元素------包括 ssget 函数的所有参数
;; [返回] 成功->选择集，反之->nil
;; [测试] (lt:ssget '("\n选择直线或圆弧: " ((0 . "line,arc"))))
;; (lt:ssget '(nil "_x" ((0 . "line,arc"))))
(defun lt:ssget (lst / oldnom ss)
(if (setq msg (car lst))
(progn
(setq oldnom (getvar "nomutt"))
(princ msg)
(setvar "nomutt" 1)
)
)
(setq ss (vl-catch-all-apply 'ssget (cdr lst)))
(if oldnom (setvar "nomutt" oldnom))
(if (not (vl-catch-all-error-p ss)) ss)
)