请修改从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)

  

)

革天明

谢谢楼主分享

ZZXXQQ

数据类型问题。

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

黄玉宏

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

ZZXXQQ

是

3xxx

看不到呀，要努力发帖。

3xxx

继续努力看看

zdqwy19

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

2. 
   
3. (defun C:TT ( / pt)  ;; pt只能作局部变量
   
4. (vl-load-com)
   
5. (setq ExcelApp (vlax-get-object "Excel.Application"))
   
6. (setq wb (vlax-get-property ExcelApp 'ActiveWorkbook))    ;;Excel工作簿对象
   
7. (setq sh (vlax-get-property wb 'ActiveSheet))   ;;Excel工作表对象
   
8. (setq range0 (vlax-get-property sh 'range "A65536"))
   
9. (setq E (vlax-get-property (vlax-get-property range0 'end -4162) 'row))
   
10. (setq Cells (vlax-get sh "cells"))
    
11.   (setq acadapp (vlax-get-Acad-Object)
    
12.        acaddoc (vla-get-ActiveDocument acadapp)
    
13.        MySpace (vla-get-ModelSpace acaddoc))
    
14. ;(setq x (vlax-get-property cells 'item 1 1))
    
15. (setq N ( + (- E 2) 1))  ;;;全部桩号个数N=E-2+1
    
16. (setq i 2)
    
17. (repeat N
    
18. (setq ZH (vlax-get-property cells 'item i 1))
    
19. (setq x (vlax-get-property cells 'item i 2))
    
20. (setq y (vlax-get-property cells 'item i 3))
    
21. (setq z (vlax-get-property cells 'item i 4))
    
22. (setq pt (append pt (list x y)))
    
23. ;;;注：以下两句为插入单行文字有问题！请帮助修改   QQ：653294278   Tel：13337788260
    
24. (setq insertionPoint (vlax-3d-point (list
    
25.           (atof (vlax-variant-value(vlax-get-property (vlax-variant-value x) 'text)))
    
26.           (atof (vlax-variant-value(vlax-get-property (vlax-variant-value y) 'text)))
    
27.           0)));;;把这一句改成这样就行了
    
28. (setq textObj(vla-AddText MySpace ZH insertionPoint 3)) ;;;ZH-A列中数据，为桩号(试图用 Lisp的"Text"方法也不行
    
29. (setq i (1+ i))
    
30. )  
    
31. (setq ptlstlen (length Pt)); 建立数组
    
32. (setq PointDataA (vlax-make-safearray vlax-vbDouble (cons 0 (1- ptlstlen))))
    
33. (vlax-safearray-fill PointDataA Pt)
    
34. (setq PointData (vlax-make-variant PointDataA))
    
35. (setq myLWpoly (vla-addLightweightPolyline MySpace PointData))
    
36. (vla-Put-Color myLWpoly acBlue)
    
37. (princ)
    
38. )

<br /> (defun C:TT ( / pt)  ;; pt只能作局部变量<br /> (vl-load-com)<br /> (setq ExcelApp (vlax-get-object "Excel.Application"))<br /> (setq wb (vlax-get-property ExcelApp 'ActiveWorkbook))    ;;Excel工作簿对象<br /> (setq sh (vlax-get-property wb 'ActiveSheet))   ;;Excel工作表对象<br /> (setq range0 (vlax-get-property sh 'range "A65536"))<br /> (setq E (vlax-get-property (vlax-get-property range0 'end -4162) 'row))<br /> (setq Cells (vlax-get sh "cells"))<br />   (setq acadapp (vlax-get-Acad-Object)<br />        acaddoc (vla-get-ActiveDocument acadapp)<br />        MySpace (vla-get-ModelSpace acaddoc))<br /> ;(setq x (vlax-get-property cells 'item 1 1))<br /> (setq N ( + (- E 2) 1))  ;;;全部桩号个数N=E-2+1<br /> (setq i 2)<br /> (repeat N<br /> (setq ZH (vlax-get-property cells 'item i 1))<br /> (setq x (vlax-get-property cells 'item i 2))<br /> (setq y (vlax-get-property cells 'item i 3))<br /> (setq z (vlax-get-property cells 'item i 4))<br /> (setq pt (append pt (list x y)))<br /> ;;;注：以下两句为插入单行文字有问题！请帮助修改   QQ：653294278   Tel：13337788260<br /> (setq insertionPoint (vlax-3d-point (list<br />           (atof (vlax-variant-value(vlax-get-property (vlax-variant-value x) 'text)))<br />           (atof (vlax-variant-value(vlax-get-property (vlax-variant-value y) 'text)))<br />           0)));;;把这一句改成这样就行了<br /> (setq textObj(vla-AddText MySpace ZH insertionPoint 3)) ;;;ZH-A列中数据，为桩号(试图用 Lisp的"Text"方法也不行<br /> (setq i (1+ i))<br /> )  <br /> (setq ptlstlen (length Pt)); 建立数组 <br /> (setq PointDataA (vlax-make-safearray vlax-vbDouble (cons 0 (1- ptlstlen))))<br /> (vlax-safearray-fill PointDataA Pt)<br /> (setq PointData (vlax-make-variant PointDataA))<br /> (setq myLWpoly (vla-addLightweightPolyline MySpace PointData))<br /> (vla-Put-Color myLWpoly acBlue)<br /> (princ)<br /> )

lxy_2080

继续努力看看