设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

返回列表
楼主: 黄卫文

[原创]:CAD中多个不同的属性快的属性写入EXCEL表中的不同表单中的程序!

[复制链接]

该用户从未签到

发表于 2003-4-13 16:52:05 | 显示全部楼层

我正在学visp,希望能多多观摩,希望谁能给我寄一份,我的E-mal:whitephoto@sina.com.多谢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对
百度谷歌雅虎搜狗搜搜有道360奇虎

使用道具 举报

该用户从未签到

发表于 2004-11-23 09:04:19 | 显示全部楼层
黄版主能否把程序改成从ACCESS里读数据?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2004-12-30 18:45:45 | 显示全部楼层
我不能下载,能发E——mail:Qinlin71@sohu.com
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1 天

连续签到: 1 天

[LV.1]初来乍到

发表于 2004-12-31 08:03:50 | 显示全部楼层
最初由 黄卫文 发布
[B]
CAD如果在运行时是没有办法清除的,如果你想尽快清出EXCEL占用的内存空间,你可以退出运行的CAD程序?.. [/B]


;;把所有的參考excel的物件都RELEASE,就可以放了EXCEL
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2005-2-16 13:38:16 | 显示全部楼层
将块的一些信息提取到EXCEL的例子,拿来与诸位分享。:)


  1. (defun c:blk2xls (/ apl-exit initexcel endexcel datacell dorow dotable appxls
  2.       xlsworkbooks newbook newsheet newitem xlscells objs count
  3.       ent claves numrow title blkss blksub blk_qty k0 i0 blkname
  4.       xscale yscale zscale rotang
  5.       blkdxf numcol insert0)
  6.   ;;;1.定义离开函数
  7.    (defun apl-exit (msg)
  8.      (endexcel)
  9.      (prompt msg)
  10.      (setq *error* oer)
  11.    )
  12.   ;;;2.initexcel用来初始M Excel
  13.   (defun initexcel ()
  14.     (setq appxls (vlax-get-or-create-object "excel.application")
  15.    xlsworkbooks (vlax-get-property appxls "workbooks")
  16.    newbook (vlax-invoke-method xlsworkbooks "add")
  17.    newsheet (vlax-get-property newbook "sheets")
  18.    newitem (vlax-get-property newsheet "item" 1)
  19.    xlscells (vlax-get-property newitem "cells")
  20.     )
  21.     (vla-put-visible appxls :vlax-true)
  22.   )
  23.   ;;;3.endexcel用来释放excel
  24.   (defun endexcel ()
  25.     (vlax-release-object xlscells)
  26.     (vlax-release-object newitem)
  27.     (vlax-release-object newsheet)
  28.     (vlax-release-object newbook)
  29.     (vlax-release-object xlsworkbooks)
  30.     (vlax-release-object appxls)
  31.   )
  32.   ;;;4.datacell将value填入numrow,col的格子中
  33.   (defun datacell (nurow col value)
  34.     (vlax-put-property xlscells "item" numrow col (vl-princ-to-string value))
  35.   )
  36.   (setq oer *error*
  37. *error* apl-exit
  38.   )
  39.   (vl-load-com)
  40.   (initexcel)
  41.   (setq numrow 1 numcol 0)
  42.   ;;;5.列出表头
  43.   (datacell numrow (setq numcol (1+ numcol)) "Bock name")
  44.   (datacell numrow (setq numcol (1+ numcol)) "X scale")
  45.   (datacell numrow (setq numcol (1+ numcol)) "Y scale")
  46.   (datacell numrow (setq numcol (1+ numcol)) "Z scale")
  47.   (datacell numrow (setq numcol (1+ numcol)) "Angle")
  48.   (datacell numrow (setq numcol (1+ numcol)) "Number")
  49.   ;;;6.依次处理各图块的参考
  50.   (setq blkdxf (tblnext "BLOCK" t))
  51.   (while blkdxf ;while1
  52.      (setq blkname (cdr (assoc 2 blkdxf))
  53.     blkss (ssget "x" (list (cons 0 "INSERT") (cons 2 blkname)))
  54.      )
  55.      (setq i0 0)
  56.      (if blkss
  57.         (setq blkss_qty (sslength blkss)) ;写出块的数量
  58.         (setq blkss_qty 0);图面上没有这个块则数量为0
  59.      )
  60.      (while (< i0 blkss_qty) ;while2 ;当有这个图块时;;;7.依条件建立图块参考的选集
  61.        (setq insert0 (ssname blkss i0)
  62.              xscale (cdr (assoc 41 (entget insert0)))
  63.       yscale (cdr (assoc 42 (entget insert0)))
  64.       zscale (cdr (assoc 43 (entget insert0)))
  65.       rotang (cdr (assoc 50 (entget insert0)))
  66.       blksub (ssget "x" (list (cons 0 "INSERT")
  67.          (cons 2 blkname)
  68.          (cons 41 xscale)
  69.          (cons 42 yscale)
  70.          (cons 43 zscale)
  71.          (cons 50 rotang)))
  72.       blkss_qty (- blkss_qty (sslength blksub))
  73.       numrow (1+ numrow)
  74.       numcol 0
  75.       k0 0
  76.         )
  77.         (while (< k0 (sslength blksub)) ;while3
  78.    (setq blkss (ssdel (ssname blksub k0) blkss))
  79.    (setq k0 (1+ k0))
  80. );end whlie3
  81.        ;;;8.写入资料
  82.        (datacell numrow (setq numcol (1+ numcol)) blkname)
  83.        (datacell numrow (setq numcol (1+ numcol)) (rtos xscale))
  84.        (datacell numrow (setq numcol (1+ numcol)) (rtos yscale))
  85.        (datacell numrow (setq numcol (1+ numcol)) (rtos zscale))
  86.        (datacell numrow (setq numcol (1+ numcol)) (rtos (* 180 (/ rotang pi))))
  87.        (datacell numrow (setq numcol (1+ numcol)) (rtos (sslength blksub) 2 0))
  88.       );end while2
  89.       (setq blkdxf (tblnext "BLOCK"))
  90.     );END WHILE1

  91.    (endexcel)
  92.    (setq *error* oer)
  93.    (princ)
  94. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2005-2-16 20:21:23 | 显示全部楼层
还是不能下载,能发给我吗
baoshun01@163.com
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2005-2-25 14:49:06 | 显示全部楼层
很好的东西!可是我不能下载!与excellink有点相似!不知道能不能往回倒数据。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2005-4-5 10:43:33 | 显示全部楼层
谢谢了,高手。我特别急需那个附件,能给俺发一个吗
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2005-9-14 09:01:43 | 显示全部楼层
这是个好东西
谢谢啦!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2006-2-21 15:47:47 | 显示全部楼层
不能下载啊?
呵呵,谁能够再上传一次么
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 29 天

连续签到: 1 天

[LV.4]偶尔看看III

发表于 2006-2-22 08:01:46 | 显示全部楼层
谢谢20楼的,源码可以参考一下,vlx格式的看不了只能用
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2006-3-7 22:47:40 | 显示全部楼层
我是新手,还有些看不懂,继续努力吧!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2006-3-15 22:28:50 | 显示全部楼层

Re: [原创]:CAD中多个不同的属性快的属性写入EXCEL表中的不同表单中的程序!

最初由 黄卫文 发布
[B]仅以此:祝晓东生日快乐!(本应该是昨天贴的。)
程序的功能:将CAD中带属性的不同名的块,将其属性值写入EXCEL表单中,表单的名称同所插入的块名相同,本程序为共享程序,如果每张表单中需要写的属性值小于300个?.. [/B]


楼主,连接失效了啊,下载不得哦,能不能给我发一份,yg972@21cn.com,谢谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2006-6-10 11:45:14 | 显示全部楼层
这个东西很好
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2006-7-26 09:03:35 | 显示全部楼层

怎么才能让下载呀

怎么才能让下载呀
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|Archiver|手机版|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

辽公网安备 21040202000005号

GMT+8, 2018-2-24 12:14 , Processed in 0.531000 second(s), 119 queries , Gzip On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

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