clh521 发表于 2009-7-3 22:09:00

谢谢分享！！！！ 最好用中文注解一下

lqss 发表于 2009-7-27 09:59:00

干什么用的？

1o2y3j4f 发表于 2009-10-12 10:55:00

tukuitk发表于2007-1-6 11:18:00static/image/common/back.gifDisplayProperties;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved(vl-load-com); Get Model Space Background Color(defun getMoBgColor()(ole_color   
;;; Change all text styles on all objects to specified text style
;;; (ax:ChangeTextStyleName "ISOCPEUR")
(defun ax:ChangeTextStyleName (style / sset ename i)
(vl-load-com)
(setq i 0)
(setq sset (ssget "X" '((-4 . "<OR") (0 . "MTEXT") (0 . "TEXT") (-4 . "OR>"))))
(if sset
    (repeat (sslength sset)
      (setq ename (ssname sset i))
      (setq i (1+ i))
      (vla-put-stylename (vlax-ename->vla-object ename) style)
    )
)
)

Zoom extents in all viewports(defun c:zoome (/ oldcmdecho vplist curcvport nr vpss ms en x)
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq vplist (mapcar 'car (vports)))
(setq curcvport (getvar "cvport"))
(if (= (getvar "tilemode") 0)
    (progn
      (if (= (setq ms (getvar "cvport")) 1)
      (command "._mspace")
      )
      (setq vpss (ssget "_x"
                        (list '(-4 . "<AND")
                              '(0 . "VIEWPORT")
                              (cons 410 (getvar "ctab"))
                              '(-4 . "<NOT")
                              '(69 . 1)
                              '(-4 . "NOT>")
                              '(-4 . "AND>")
                        )
               )
      )
      (setq nr 0)
      (if vpss                        ; in case there are no viewports
      (repeat (sslength vpss)
          (setq en (entget (ssname vpss nr)))
          (if (and (= 0 (logand 1 (cdr (assoc 90 en))))
                                        ; not perspective
                   (< 0 (cdr (assoc 68 en))) ; on and active
                   (/= 16384 (logand 16384 (cdr (assoc 90 en))))
                                        ; not locked
            )
            (progn
            (setvar "cvport" (cdr (assoc 69 en)))
            (command "._zoom" "_e")
            )
          )
          (setq nr (+ 1 nr))
      )
      )
      (if (= ms 1) (command "._pspace"))
    )
    (foreach x vplist
      (setvar "cvport" x)
      (command "._zoom" "_e")
    )
)
(setvar "cvport" curcvport)
(setvar "cmdecho" oldcmdecho)
(princ)
)



楼主，您好！可否注明一下每个程序的功能。谢谢啦！

xiaowen 发表于 2010-5-30 16:41:00

<p>感谢分享,学习了.</p>

limter 发表于 2012-10-19 14:56:00

                        

xchj81 发表于 2014-7-26 21:45:46

我试一下，不错, 谢谢楼主分享！！

l67844260 发表于 2014-8-25 13:11:03

感谢分享            

看天的小树 发表于 2014-10-24 22:42:23

不错, 谢谢楼主分享！！

侧影中有你 发表于 2015-1-7 11:59:50

谢谢楼主。

kkt123 发表于 2015-2-2 17:45:37

谢谢分享！！！！
页: 1 [2] 3
查看完整版本: 分享几个VL程序