明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: tukuitk

分享几个VL程序

  [复制链接]
发表于 2009-7-3 22:09 | 显示全部楼层
谢谢分享!!!! 最好用中文注解一下
发表于 2009-7-27 09:59 | 显示全部楼层
干什么用的?
发表于 2009-10-12 10:55 | 显示全部楼层
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
  1. (defun c:zoome (/ oldcmdecho vplist curcvport nr vpss ms en x)
  2.   (setq oldcmdecho (getvar "cmdecho"))
  3.   (setvar "cmdecho" 0)
  4.   (setq vplist (mapcar 'car (vports)))
  5.   (setq curcvport (getvar "cvport"))
  6.   (if (= (getvar "tilemode") 0)
  7.     (progn
  8.       (if (= (setq ms (getvar "cvport")) 1)
  9.         (command "._mspace")
  10.       )
  11.       (setq vpss (ssget "_x"
  12.                         (list '(-4 . "<AND")
  13.                               '(0 . "VIEWPORT")
  14.                               (cons 410 (getvar "ctab"))
  15.                               '(-4 . "<NOT")
  16.                               '(69 . 1)
  17.                               '(-4 . "NOT>")
  18.                               '(-4 . "AND>")
  19.                         )
  20.                  )
  21.       )
  22.       (setq nr 0)
  23.       (if vpss                          ; in case there are no viewports
  24.         (repeat (sslength vpss)
  25.           (setq en (entget (ssname vpss nr)))
  26.           (if (and (= 0 (logand 1 (cdr (assoc 90 en))))
  27.                                         ; not perspective
  28.                    (< 0 (cdr (assoc 68 en))) ; on and active
  29.                    (/= 16384 (logand 16384 (cdr (assoc 90 en))))
  30.                                         ; not locked
  31.               )
  32.             (progn
  33.               (setvar "cvport" (cdr (assoc 69 en)))
  34.               (command "._zoom" "_e")
  35.             )
  36.           )
  37.           (setq nr (+ 1 nr))
  38.         )
  39.       )
  40.       (if (= ms 1) (command "._pspace"))
  41.     )
  42.     (foreach x vplist
  43.       (setvar "cvport" x)
  44.       (command "._zoom" "_e")
  45.     )
  46.   )
  47.   (setvar "cvport" curcvport)
  48.   (setvar "cmdecho" oldcmdecho)
  49.   (princ)
  50. )


楼主,您好!可否注明一下每个程序的功能。谢谢啦!
发表于 2010-5-30 16:41 | 显示全部楼层

感谢分享,学习了.

发表于 2012-10-19 14:56 | 显示全部楼层
                        
发表于 2014-7-26 21:45 | 显示全部楼层
我试一下,不错, 谢谢楼主分享!!
发表于 2014-8-25 13:11 | 显示全部楼层
感谢分享            
发表于 2014-10-24 22:42 | 显示全部楼层
不错, 谢谢楼主分享!!
发表于 2015-1-7 11:59 | 显示全部楼层
谢谢楼主。
发表于 2015-2-2 17:45 | 显示全部楼层
谢谢分享!!!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 13:11 , Processed in 0.160803 second(s), 16 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表