分享几个VL程序

tukuitk

DisplayProperties

2. ;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
4. (vl-load-com)
6. ; Get Model Space Background Color
7. (defun getMoBgColor()
8.   (ole_color
9.     (vla-get-GraphicsWinModelBackgrndColor
10.       (vla-get-display (vla-get-preferences (vlax-get-acad-object)))))
11. )
13. ; Get Layout Space Background Color
14. (defun getLaBgColor()
15.   (ole_color
16.     (vla-get-GraphicsWinLayoutBackgrndColor
17.       (vla-get-display (vla-get-preferences (vlax-get-acad-object)))))
18. )
20. ; Put Model Space Background Color
21. (defun putMoBgColor(bgc)
22.   (vla-put-GraphicsWinModelBackgrndColor
23.     (vla-get-display (vla-get-preferences (vlax-get-acad-object)))
24.     bgc
25.   )
26. )
28. ; Put Layout Space Background Color
29. (defun putLaBgColor(bgc)
30.   (vla-put-GraphicsWinLayoutBackgrndColor
31.     (vla-get-display (vla-get-preferences (vlax-get-acad-object)))
32.     bgc
33.   )
34. )
36. (defun ole_color(olec)
37.   (vlax-variant-value
38.     (vlax-variant-change-type olec vlax-vbDouble)
39.   )
40. )
42. ; Get the display of the Plot Setup dialog when a new layout is created.
43. (defun getLayoutShowPlotSetup()
44.   (vla-get-LayoutShowPlotSetup
45.     (vla-get-display (vla-get-preferences (vlax-get-acad-object))))
46. )
48. ; Put the display of the Plot Setup dialog when a new layout is created.
49. (defun putLayoutShowPlotSetup(state)
50.   (vla-put-LayoutShowPlotSetup
51.     (vla-get-display (vla-get-preferences (vlax-get-acad-object))) state)
52. )
54. ; Toggles the display of the Plot Setup dialog when a new layout is created.
55. (defun toggleLayoutShowPlotSetup()
56.   (if (= (getLayoutShowPlotSetup) :vlax-true)
57.     (putLayoutShowPlotSetup :vlax-false)
58.     (putLayoutShowPlotSetup :vlax-true)
59.   )
60. )

;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved (vl-load-com) ; Get Model Space Background Color (defun getMoBgColor()   (ole_color     (vla-get-GraphicsWinModelBackgrndColor       (vla-get-display (vla-get-preferences (vlax-get-acad-object))))) ) ; Get Layout Space Background Color (defun getLaBgColor()   (ole_color     (vla-get-GraphicsWinLayoutBackgrndColor       (vla-get-display (vla-get-preferences (vlax-get-acad-object))))) ) ; Put Model Space Background Color (defun putMoBgColor(bgc)   (vla-put-GraphicsWinModelBackgrndColor     (vla-get-display (vla-get-preferences (vlax-get-acad-object)))     bgc   ) ) ; Put Layout Space Background Color (defun putLaBgColor(bgc)   (vla-put-GraphicsWinLayoutBackgrndColor     (vla-get-display (vla-get-preferences (vlax-get-acad-object)))     bgc   ) ) (defun ole_color(olec)   (vlax-variant-value     (vlax-variant-change-type olec vlax-vbDouble)   ) ) ; Get the display of the Plot Setup dialog when a new layout is created. (defun getLayoutShowPlotSetup()   (vla-get-LayoutShowPlotSetup     (vla-get-display (vla-get-preferences (vlax-get-acad-object)))) ) ; Put the display of the Plot Setup dialog when a new layout is created. (defun putLayoutShowPlotSetup(state)   (vla-put-LayoutShowPlotSetup     (vla-get-display (vla-get-preferences (vlax-get-acad-object))) state) ) ; Toggles the display of the Plot Setup dialog when a new layout is created. (defun toggleLayoutShowPlotSetup()   (if (= (getLayoutShowPlotSetup) :vlax-true)     (putLayoutShowPlotSetup :vlax-false)     (putLayoutShowPlotSetup :vlax-true)   ) )

[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

2. (defun c:zoome (/ oldcmdecho vplist curcvport nr vpss ms en x)
3.   (setq oldcmdecho (getvar "cmdecho"))
4.   (setvar "cmdecho" 0)
5.   (setq vplist (mapcar 'car (vports)))
6.   (setq curcvport (getvar "cvport"))
7.   (if (= (getvar "tilemode") 0)
8.     (progn
9.       (if (= (setq ms (getvar "cvport")) 1)
10.         (command "._mspace")
11.       )
12.       (setq vpss (ssget "_x"
13.                         (list '(-4 . "<AND")
14.                               '(0 . "VIEWPORT")
15.                               (cons 410 (getvar "ctab"))
16.                               '(-4 . "<NOT")
17.                               '(69 . 1)
18.                               '(-4 . "NOT>")
19.                               '(-4 . "AND>")
20.                         )
21.                  )
22.       )
23.       (setq nr 0)
24.       (if vpss                          ; in case there are no viewports
25.         (repeat (sslength vpss)
26.           (setq en (entget (ssname vpss nr)))
27.           (if (and (= 0 (logand 1 (cdr (assoc 90 en))))
28.                                         ; not perspective
29.                    (< 0 (cdr (assoc 68 en))) ; on and active
30.                    (/= 16384 (logand 16384 (cdr (assoc 90 en))))
31.                                         ; not locked
32.               )
33.             (progn
34.               (setvar "cvport" (cdr (assoc 69 en)))
35.               (command "._zoom" "_e")
36.             )
37.           )
38.           (setq nr (+ 1 nr))
39.         )
40.       )
41.       (if (= ms 1) (command "._pspace"))
42.     )
43.     (foreach x vplist
44.       (setvar "cvport" x)
45.       (command "._zoom" "_e")
46.     )
47.   )
48.   (setvar "cvport" curcvport)
49.   (setvar "cmdecho" oldcmdecho)
50.   (princ)
51. )

(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) )

大西瓜

虽然帖子有些久远了，感谢阁主无私奉献

l982414603

是啥程序？请介绍一下。

xlh0

谢谢分享！！！！

fly_902

不错, 谢谢楼主分享

mingvictor

谢谢楼主！

dym123456

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

zgssd

是啥程序？请介绍一下。

chern0228

不错, 谢谢楼主分享

lqss

干什么用的程序啊？

waterchen

不错, 谢谢楼主分享

明_明

谢谢分享