建筑新时代论坛's Archiver

【热门搜索】建材Autocad膜结构钢结构加固招聘工程机械测绘建筑材料工程造价建筑施工图

bnyckl 发表于 2007-3-27 21:34

集成自己写的几个程序--符号表管理器

;;;***********************************
;;;主程序.............................
;;;highflybird......2007/03/03 Kunming
;;;***********************************
(prompt "命令为sym")
(defun C:sym (/ ID1 ok allkey sslist symlst SList1 SNlist
            symNam NamLst Option allkey *APP *DOC *BLK)
  (vl-load-com)
  (setq *APP (vlax-get-acad-object))
  (setq *DOC (vla-get-activeDocument *APP))
  (setq *BLK (vla-get-blocks *DOC))
  (setq ID1  (load_dialog "symtable2.dcl"))
  (setq ok 2)
  (setq allkey (list "P3" "P61" "P62" "P63" "P64" "P65" "P66" "P67" "P68" "P69" "P70"))
  (if (new_dialog "sym_table" ID1)
    (progn     
      (key_status allkey 1)
      (while (> ok 1)
    (action)
        (setq ok (start_dialog))
        (setq symNam (car symlst) NamLst (cadr symlst))
        (if NamLst
      (cond
        ( (= ok 2)
          (setq Option 2)
        );建选择集
        ( (= ok 3)
              (setq SList1 (select symNam))
              (NewDiaLog2)
          (setq Option 3)
        );选择物体
        ( (and (= ok 62) SList1)
          (all-rename)
          (setq Option 1)
          (NewDiaLog2)
        );批量改名
        ( (= ok 63)
          (count)
          (setq Option 1)
          (NewDiaLog2)
        );统计数量
        ( (and (= ok 64) SList1)
          (null (vla-purgeall *DOC))
          (setq Option 1)
          (NewDiaLog)
        );清理删除
        ( (and (= ok 65) SList1)
          (Change_to_Other symNam 425)
          (setq Option 1)
          (NewDiaLog)
        );合并归一
        ( (and (= ok 66) SList1 (setq color (acad_colordlg 256)))
              (setq NewPro (cons 62 color))
              (change NewPro)
          (setq Option 1)
          (NewDiaLog2)
        );批改颜色
        ( (and (= ok 67) SList1)
          (Change_to_Other "LAYER" 8)
          (NewDiaLog2)
        );批改图层
        ( (and (= ok 68) SList1)
          (Change_to_Other "LTYPE" 6)
          (NewDiaLog2)
        );批改线型
        ( (and (= ok 69) SList1)
          (Change_to_Other "STYLE" 7)
          (NewDiaLog2)
        );批改文字
        ( (and (= ok 70) SList1)
          (Change_to_Other "DIMSTYLE" 3)
          (NewDiaLog2)
        );批改标注
      );cond
        );if
      );while
      (unload_dialog ID1)
      (cond
    ( (null Option) (princ "\n不进行任何操作!") (princ))
    ( (=  Option 0) (princ "\n你已经取消操作!") (princ))
    ( (=  Option 1) (princ "\n你已经完成操作!") (princ))
        ( (=  Option 2) (princ "\n") SList1)   
        ( t (princ))
      );cond
    );progn
    (progn
      (alert "对话框加载失败")
      (princ)
    );progn
  );if
);defun

zzht2525 发表于 2007-4-3 13:59

好人!谢谢搂主

highflybird 发表于 2007-4-18 18:18

如果要转载,请完整转载吧。
明经通道:
[url]http://www.mjtd.com/BBS/dispbbs.asp?boardID=3&ID=58564&page=1[/url]
晓冬论坛:
[url]http://p4.xdcad.net/forum/showthread.php?s=&threadid=624864[/url]
ABBS论坛:
[url]http://www.abbs.com.cn/bbs/post/view?bid=31&id=335160454&sty=1&tpg=1&age=60[/url][attach]72815[/attach]

[[i] 本帖最后由 highflybird 于 2007-4-18 18:20 编辑 [/i]]

我爱吃肥肉 发表于 2007-12-12 16:44

应该介绍一下使用方法和主要功能。谢谢提供下载

ccgecmys 发表于 2008-1-1 02:50

这样发贴,我喜欢,不用附币

页: [1]

Powered by Discuz! Archiver 6.1.0  © 2001-2007 Comsenz Inc.