【分享明经——发程序、拜新年专贴】

HRQ28 · 发表于 2008-12-30 11:34:00

后天就是新年了，祝大家新年快乐，牛年更牛。

nameld001 · 发表于 2009-1-1 13:06:00

新年快乐!

jaminth · 发表于 2009-1-3 20:58:00

新年快乐!

coolpoom · 发表于 2009-1-5 09:48:00

Happy 牛 year!!

jxphklibin · 发表于 2009-1-5 10:56:00

本帖最后由作者于 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
)

huiyin · 发表于 2009-1-5 13:48:00

桩孔自动编号、勘察自动编号、生成剖面及桩长统计程序（免费申请2009全功能版）
自动生成EXCEL统计表格
  自动生成剖面
  勘察cad编号
  桩孔CAD编号
桩孔编号程序（2009版，免费申请全功能）


  下载地址：HTTP://SCKCY.YS168.COM
免费赠送100个正式版，欲申请从速。

AMTONNY · 发表于 2009-1-11 19:38:00

偶也来占个位置

zhuquanmao · 发表于 2009-1-20 22:20:00

;单显图层程序 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)
)

BDYCAD · 发表于 2009-1-28 09:53:00

祝大家春节快乐!身体健康!

jxphklibin · 发表于 2009-2-4 20:51:00

本帖最后由作者于 2009-2-4 21:25:47 编辑

caoyin发表于2008-12-6 13:23:00;;选择对象 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)
)

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

【分享明经——发程序、拜新年专贴】

评分

评分

评分