分享几个VL程序

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:00DisplayProperties;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved(vl-load-com); Get Model Space Background Color(defun getMoBgColor() (ole_color

[code] ;;; 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) ) ) ) [/code]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)
)

(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

感谢分享,学习了.

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

谢谢分享！！！！

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