求助 谁能帮我改一下这个程序啊
本帖最后由 Jerry_zion 于 2013-3-1 15:20 编辑原代码如下
(defun C:TT ( / pt);; pt只能作局部变量
(vl-load-com)
(setq ExcelApp (vlax-get-object "Excel.Application"))
(setq wb (vlax-get-property ExcelApp 'ActiveWorkbook)) ;;Excel工作簿对象
(setq sh (vlax-get-property wb 'ActiveSheet)) ;;Excel工作表对象
(setq range0 (vlax-get-property sh 'range "A65536"))
(setq E (vlax-get-property (vlax-get-property range0 'end -4162) 'row))
(setq Cells (vlax-get sh "cells"))
(setq acadapp (vlax-get-Acad-Object)
acaddoc (vla-get-ActiveDocument acadapp)
MySpace (vla-get-ModelSpace acaddoc))
;(setq x (vlax-get-property cells 'item 1 1))
(setq N ( + (- E 2) 1));;;全部桩号个数N=E-2+1
(setq i 2)
(repeat N
(setq ZH (vlax-get-property cells 'item i 1))
(setq x (vlax-get-property cells 'item i 2))
(setq y (vlax-get-property cells 'item i 3))
(setq z (vlax-get-property cells 'item i 4))
(setq pt (append pt (list x z )))
(setq insertionPoint (vlax-3d-point (list
(atof (vlax-variant-value(vlax-get-property (vlax-variant-value x) 'text)))
(atof (vlax-variant-value(vlax-get-property (vlax-variant-value y) 'text)))
0)));;;把这一句改成这样就行了
(setq textObj(vla-AddText MySpace ZH insertionPoint 3)) ;;;ZH-A列中数据，为桩号(试图用 Lisp的"Text"方法也不行
(setq i (1+ i))
)
(setq ptlstlen (length Pt)); 建立数组
(setq PointDataA (vlax-make-safearray vlax-vbDouble (cons 0 (1- ptlstlen))))
(vlax-safearray-fill PointDataA Pt)
(setq PointData (vlax-make-variant PointDataA))
(setq myLWpoly (vla-addLightweightPolyline MySpace PointData))
(vla-Put-Color myLWpoly acBlue)
(princ)
)
这是坛子里某位高手编写的关联excel，用电子表格数据标桩号，绘多义线的程序，现在该程序绘制的多义线为多段线，也就是LightweightPolyline 我现在需要绘制三维多义线 我该如何修改啊
页:
[1]