jlluozhenpin
发表于 2007-10-10 20:01:00
这个问题非常容易做到，我的软件就可以，你可以到<a href="http://www.shuigong.com">www.shuigong.com</a>的施工软件中下载“飞翔水利施工软件”，ok
yefeiwolaile
发表于 2007-10-21 17:14:00
<p>Sub text()</p><p></p><p>Dim p(0 To 2) As Double '定义坐标变量</p><p></p><p><br/>ss$ = CStr(dydqxls)</p><p>MsgBox ss</p><p><br/>p(0) = 310.77: p(1) = 42: p(2) = 0 '坐标赋值</p><p><br/>Set txtobj = ThisDrawing.PaperSpace.AddMText(p, 50, ss)</p><p></p><p>End Sub</p><p></p><p><br/>Function dydqxls()</p><p></p><p><br/>Dim ExcelApp As Excel.Application</p><p></p><p>On Error Resume Next</p><p> Set ExcelApp = GetObject(, "Excel.Application")</p><p> If Err <> 0 Then</p><p> Set ExcelApp = CreateObject("Excel.Applicationn")</p><p>End If</p><p><br/> a = ExcelApp.ActiveWorkbook.Sheets("数据输入").Range("b11").Value</p><p></p><p>dydqxls = a</p><p></p><p>End Function</p><p></p><p>从当前EXCEL文件中提取B11单元格内数据，于CAD图纸空间指定点写一个文本，字符串为B11内字符</p>
兰州人
发表于 2007-12-5 15:34:00
<p>我常用Autocad与Excel的程序</p><p>Sub WriteTextToMaterialTable()<br/> Dim Ent As AcadEntity<br/> Dim tt As AcadText, ll As AcadLine, ii As Integer<br/> Dim InsertPoint(0 To 2) As Double<br/> Set xlSheet = xlApp.ActiveSheet<br/> For ii = 1 To 6<br/> InsertPoint(0) = xlSheet.Cells(ii, 2): InsertPoint(1) = xlSheet.Cells(ii, 3)<br/> Set tt = ThisDrawing.ModelSpace.AddText(xlSheet.Cells(ii, 1), InsertPoint, xlSheet.Cells(ii, 4))<br/> With tt<br/> .Height = xlSheet.Cells(ii, 4).Value<br/> .ScaleFactor = xlSheet.Cells(ii, 5).Value<br/> .StyleName = Trim(xlSheet.Cells(ii, 6).Value)<br/> '.Layer = Trim(xlSheet.cells(ii, 7).Value)<br/> .Layer = Trim(xlSheet.Cells(ii, 8).Value)<br/> End With<br/> Next ii<br/>End Sub</p><p>'调用Excel通讯程序</p><p>Function xlApp() As Object</p><p> 'Dim xlApp As Object ' This Line ,Not set Excel , run Excel<br/> 'Dim xlsheet As Object<br/> <br/> ' 发生错误时跳到下一个语句继续执行<br/> On Error Resume Next<br/> ' 连接Excel应用程序<br/> Set xlApp = GetObject(, "Excel.Application")<br/> <br/> If Err.Number <> 0 Then<br/> Set xlApp = CreateObject("Excel.Application")<br/> xlApp.Visible = True<br/> xlApp.Workbooks.Add<br/> End If</p><p> ' 返回当前活动的工作表<br/>' Set xlSheet = xlApp.ActiveSheet<br/>End Function</p>
huiyin
发表于 2008-1-10 09:28:00
先调用EXCEL生成数据文件，再调用CAD使用数据文件绘图。
lolanda
发表于 2008-3-4 16:48:00
有Vlisp源代码吗？
liusong0517
发表于 2008-4-1 20:39:00
hao 谢谢大家,我刚学的,在上面了解了好多东西,有成就一定共享
无声
发表于 2008-4-12 00:07:00
<p>王华武舾装辅助设计系统(船舶舾装图纸设计辅助软件gsi升级版)试用版 <br/>以下是船舶软件的下载联接。 </p><p>中国国防科技论坛 <br/>http://bbs.81tech.com/index.php <br/>下载页 <br/>http://bbs.81tech.com/read.php?tid-83069-fpage-0-toread--page-1.html </p><p>由于上传过程确实过于痛苦，因为软件太大，分25个分卷。所以只好引用了。希望见谅！ <br/>如果管理员有时间的话，可以整理下，并将其上传至此！谢谢！！！ <br/>由于软件过大。尝试了N次多卷一起上传但是都不成功，只好一个一个的上传。希望管理员不要见怪，如果可能的话，希望管理员整理一下。 <br/>分25卷上传。请将所有分卷下载到同一个文件夹内再进行解压缩，然后安装既可使用。若安装不成功，请下载VB6.0中文企业版(百度搜索应该有破解版）。安装VB6.0，然后再安装此软件。此软件自动绘制CAD格式明细表的功能必须结合AutoCAD2004才能完成，其他版本不支持。若没有安装AutoCAD2004，则无法实现自动绘制明细表！要实现其他版本支持是可以实现的，只是本人时间紧迫，白天要上班，下班才有时间编写程序。本人的正职工作是船舶设计，而不是程序开发。程序开发是业余爱好而已，请各位见谅！ </p><p>下图为此程序明细表的操作界面，其余界面在此不便一一展开！ </p><p>点击下图可放大，便于清晰观看，增加了解！ <br/>http://tot.any2000.com/t/o/tot/lmpicture/1534692.gif </p><p>以下是生成的明细表样本（调试时生成的，非标准格式） <br/>点击下图可放大，便于清晰观看，增加了解！ <br/>[http://tot.any2000.com/t/o/tot/lmpicture/1534691.gif </p><p>&lt;王华武舾装辅助设计系统&gt;是根据舾装设计需要，在运用Access数据库的技术基础上，结合AutoCAD二次开发技术；运用VB6.0编程语言平台综合设计而成。在数据库技术的支持下，可省却设计手册查找的功能，并达成自动运算功能，省却人工复杂而烦琐的重量计算和反复的数据信息填写。在AutoCAD二次开发技术的支持下，可以完成自动绘制明细表的功能。省却人工绘制明细表的过程。与此同时，本程序还根据设计需要，完成了连接件自动匹配的运算功能模块，省却设计手册的查找和运算，从而实现快速运算匹配，并提供了图文并貌的直观性。 <br/>以上功能模块，总体上缩短了设计时间，提供了设计效率和准确性。 </p><p>数据库： <br/>明细表数据库，材料表数据库，连接件表数据库 <br/>明细表可存，可添加，可修改，可插入，可删除，其行可上下调整等。 <br/>材料表和连接件表可存，可添加，可修改，可删除等。 </p><p>本人未来得及完善数据库，请使用者根据需要和程序要求自行添加相关数据。 </p><p>此软件操作多次用到鼠标右键。请各位摸索。因为时间匆忙，使用手册没做详细说明。 <br/>谢谢各位。</p>
QUAI
发表于 2009-3-12 14:29:00
我好久没来了.不能帮你.
xofox
发表于 2009-4-9 22:19:00
<p><font color="#000000">下面是一个自动读取csv文件（逗号分隔文本文件，可用execl打开）按坐标、标注等数据绘制钻孔的程序，看看有没有用</font></p><p><font color="#f70909">;绘制钻孔.lsp----v2.0<br/>;从数据文件中读取钻孔参数，自动绘制钻孔及标注，请首先确认数据文件符合要求<br/>;各行中不要出现多余的换行符，否则会发生错误<br/>;有一列标题行，按顺序为0序号，1钻窝编号，2钻孔号，3开口X，4开口Y，5开口Z，6孔深，7方位，8倾角，9本溪顶孔深（煤孔则为末段孔深）-><br/>;->10本溪底孔深（煤孔则为终孔岩性），11初见水孔深，12初见水量，13最大水孔深，14最大水量，15水压，16注浆量，17注浆终压，18终孔层位，19施工日期，20目的，21水温<br/>(defun c:rdata()<br/> (setq sysang (getvar "ANGDIR")) ;取得角度方向（顺时针/逆时针）<br/> (setvar "ANGDIR" 0) ;设置为逆时针方向<br/> (setq sysabase (getvar "ANGBASE")) ;取得方向的基准角度<br/> (setvar "ANGBASE" 0) ;设置方向的基准角度为东<br/> (setq sysvar (getvar "OSMODE")) ;获得并保存对象捕捉设置<br/> (setvar "OSMODE" 16384) ;关闭对象捕捉</font></p><p><font color="#f70909"> (setq data (open (getfiled "选择CSV数据文件" "d:/打钻资料.csv" "csv" 8) "r"))<br/> (setq bh (getint "从第几条记录开始读取数据："))<br/> (repeat bh (setq bz (read-line data)))<br/> (if bz (princ "ok") (progn (princ "输入错误！！")(exit)))</font></p><p><font color="#f70909"> (setq b1 '(0) b2 nil)<br/> (setq m 0 n 1 i 0 ) <br/> (while (setq s1 (read-line data))<br/> (while (<= n (strlen s1))<br/> (setq ch (substr s1 n 1))<br/> (if (= ch ",")<br/> (progn (setq m (1+ m)) (setq b1 (cons n b1)) )<br/> )<br/> (setq n (1+ n))<br/> )<br/> (setq b1 (reverse b1))<br/>; (princ b1)<br/> (repeat m<br/> (setq e1 (+ (nth i b1) 1))<br/> (setq e2 (nth (+ i 1) b1))<br/> (setq b2 (cons (substr s1 e1 (- e2 e1)) b2) )<br/> (setq i (1+ i))<br/> )<br/> (setq b2 (reverse b2))<br/> <br/> (setq p1 (list(atof (nth 3 b2))(atof (nth 4 b2))) )<br/> (setq t1 (rtos (* (atof (nth 6 b2)) (cos (*(/(atof(nth 8 b2)) 180) pi)) )))<br/> (setq t2 (itoa (- 90 (atoi (nth 7 b2)))))<br/> (setq s2 (strcat "@" t1"<" t2))<br/>; (setq s3 (strcat (nth 1 b2) ":孔深" (nth 5 b2)"m,方位" (nth 6 b2)",倾角"(nth 7 b2) ".初见水孔深" (nth 8 b2) "m,初见水量" (nth 9 b2)",最大水孔深" (nth 10 b2) "m,最大水量" (nth 11 b2)",水压" (nth 12 b2) ",日期:" (nth 13 b2)",终孔层位:" (nth 14 b2)"." ))<br/> (command "line" p1 s2 "")</font></p><p><br/><font color="#f70909"> (command "ucs" "") ;设置为wcs<br/> (setq p2 (cdr (assoc 11 (entget(entlast)))))<br/> (command "circle" p2 1.5) ;画圆<br/> (command "pline" (list (- (car p2) 10) (cadr p2)) (list (- (car p2) 2) (cadr p2)) "")<br/> (command "pline" (list (+ (car p2) 2) (cadr p2)) (list (+ (car p2) 13) (cadr p2)) "") ;画线<br/> <br/> (command "-text" "j" "mc" (list (car p2) (+ 8 (cadr p2))) 3 0 (nth 2 b2)) ;钻孔名称<br/> (command "-text" "j" "mc" (list (car p2) (+ 5 (cadr p2))) 2 0 (strcat (nth 7 b2) "/" (nth 8 b2)));方位/倾角<br/> (command "-text" (list (- (car p2) 10) (+ 0.5 (cadr p2))) 2 0 (nth 5 b2));开孔Z值<br/> (command "-text" (list (+ (car p2) 2) (+ 0.5 (cadr p2))) 2 0 (strcat (nth 9 b2) "/" (nth 10 b2)));本灰孔段或未段孔深岩性<br/> (command "-text" (list (- (car p2) 10) (- (cadr p2) 2.5)) 2 0 (nth 11 b2)) ;初见水孔深<br/> (command "-text" (list (- (car p2) 10) (- (cadr p2) 5)) 2 0 (nth 13 b2)) ;最大水孔深<br/> (command "-text" (list (+ (car p2) 5) (- (cadr p2) 2.5)) 2 0 (nth 12 b2)) ;初见水量<br/> (command "-text" (list (+ (car p2) 5) (- (cadr p2)5)) 2 0 (strcat (nth 14 b2) "/" (nth 15 b2)));最大水量/水压<br/> (command "-text" "j" "mc" (list (car p2) (- (cadr p2) 3)) 2 0 (strcat (nth 16 b2) "/" (nth 17 b2))) ;注浆量/终注压力<br/> <br/> (command "ucs" "p") ;恢复ucs<br/> <br/>; (setq x1 (+(*(cos (*(/ (atof t1) 180)pi))(atof(nth 5 b2)))(car p1)) )<br/>; (setq y1 (+(*(sin (*(/ (atof t1) 180)pi))(atof(nth 5 b2)))(cadr p1)) )<br/>; (setq p2 (list x1 y1))<br/>; (setq x2 (+(*(cos (+(atan 0.3) (*(/ (atof t1) 180)pi))) 50) x1))<br/>; (setq y2 (+(*(sin (+(atan 0.3) (*(/ (atof t1) 180)pi))) 50) y1))<br/>; (setq p3 (list x2 y2 ))<br/>; (command "-mtext" p2 "r" (itoa (- 90 (atoi (nth 6 b2)))) "h" 2.5 p3 s3 "")<br/>; (princ "\n")<br/>; (princ p3)<br/>; (princ",")<br/> ; (princ (- y1 (cadr p1)))<br/>; (print y1)<br/>; (princ b2)<br/>;<br/> (setq n 1 m 0 b1 '(0) b2 nil i 0)<br/> )<br/>; (princ "\n")</font></p><p><font color="#f70909"> (close data)<br/> (setvar "ANGDIR" sysang) ;恢复角度方向<br/> (setvar "ANGBASE" sysabase) ;恢复方向的基准角度<br/> (setvar "OSMODE" sysvar) ;恢复对象捕捉设置<br/>)</font></p>
wangdeshow
发表于 2010-9-24 14:07:00
10楼给<a href="mailto:wangdeshow@163.com">wangdeshow@163.com</a>发一个，谢谢。