黄玉宏 发表于 2012-2-11 20:14:55

请修改从Excel读数据生成多段线不能标注文字问题

请帮助修改从Excel读取数据并生成多段线程序中标注桩号(A列中单行文字)的问题。能生成多段线。感觉是从Excel读取的坐标数据类型不对，CAD中显示：错误: 参数类型错误: numberp: #<variant 9 -196.534270122988>，去掉生成单行文字的两句程序就正常运行。刚学Lisp 不久，请各位帮助。谢谢！程序见附件。黄玉宏二○一二年二月十一日
(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 y)));;;注：以下两句为插入单行文字有问题！请帮助修改   QQ：653294278   Tel：13337788260;;;(setq insertionPoint (vlax-3d-point (list x y 0)))      ;;;插入单行文字(桩号)，有问题!CAD提示： 错误: 参数类型错误: numberp: #<variant 9 -196.534270122988>;;;(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))

革天明 发表于 2012-2-12 08:32:16

谢谢楼主分享

ZZXXQQ 发表于 2012-2-12 19:37:04

数据类型问题。

(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 N (1+ (- E 2)));;;全部桩号个数N=E-2+1
(setq i 2)
(repeat N
(setq ZH (vlax-variant-value (vlax-variant-change-type (vlax-get-property cells 'item i 1) 8)))
(setq x (vlax-variant-value (vlax-variant-change-type (vlax-get-property cells 'item i 2) 4)))
(setq y (vlax-variant-value (vlax-variant-change-type (vlax-get-property cells 'item i 3) 4)))
(setq z (vlax-variant-value (vlax-variant-change-type (vlax-get-property cells 'item i 4) 2)))
(setq pt (list x y))
(command ".TEXT" pt 3 "" ZH)
(setq i (1+ i))
)
(princ)
)

黄玉宏 发表于 2012-2-12 22:43:37

非常感谢，请问你是昨天在群里的那位工程师吗？

ZZXXQQ 发表于 2012-2-12 23:02:56

是

3xxx 发表于 2012-2-26 15:39:24

看不到呀，要努力发帖。

3xxx 发表于 2012-2-26 16:12:49

继续努力看看

zdqwy19 发表于 2012-4-9 18:49:44

本帖最后由 zdqwy19 于 2012-4-9 18:53 编辑

         有问题的是这一句(setq insertionPoint (vlax-3d-point (list x y 0)))，改这一句就可以了，其余没有动。下面是改过的程序。

(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 y)))
;;;注：以下两句为插入单行文字有问题！请帮助修改   QQ：653294278   Tel：13337788260
(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)
)

lxy_2080 发表于 2014-4-6 02:02:18

继续努力看看
页: [1]
查看完整版本: 请修改从Excel读数据生成多段线不能标注文字问题