可视化测量动态输入到excel表
各位大老好，有个问题需要请大老们帮助修改，功能是:在图上测量距离动态输入excel活动工作表，
现在是可以从第一行开逐行输入结果，但是 每从新 启命令时 就有会从第一行开逐行输入，这样就会掩盖老数据，
请大老们帮忙修改修改，谢谢各位了!
;可视化测量======每从新 启命令时 就有会从第一行开逐行输入，这样就会掩盖老数据，
(defun c:qqt1234 (/ pt pt3 pt4 ww msg df pts dist1 dist2 p1 excel workbooks workbook worksheet row M)
(setq M 1)
;;;--- 写入Excel ---
(setq row 2) ; 初始化Excel行号
(setq excel (vlax-get-or-create-object "Excel.Application"))
(setq workbooks (vlax-get-property excel 'Workbooks))
(if (= (vlax-get-property workbooks 'count) 0)
(setq workbook (vlax-invoke-method workbooks 'Add))
(setq workbook (vlax-get-property workbooks 'item 1))
)
(setq worksheet (vlax-get-property (vlax-get-property workbook 'Worksheets) 'item 1))
;;;-------------------------------;;;--- 写入Excel --- ;;;--- 首次运行时添加标题行 ---
(vlax-put-property (vlax-get-property worksheet 'Range "A1") 'Value2 "测量名称")
(vlax-put-property (vlax-get-property worksheet 'Range "B1") 'Value2 "线段序号")
(vlax-put-property (vlax-get-property worksheet 'Range "C1") 'Value2 "分段长度")
(vlax-put-property (vlax-get-property worksheet 'Range "D1") 'Value2 "累计长度")
;(setq row 2) ; 初始化Excel行号
(while (progn
; 弹出对话框输入自定义名称
(setq pt3 (getstring T "\n请输入自定测量名称: "))
(if (not (equal pt3 "")) ; 如果输入不为空则继续测量
(progn
(setq pt (getpoint "\n 请指定开始点: "))
(setq p1 (getpoint pt "\n 请指定下一点: "))
(setq dist1 (distance p1 pt))
(princ (strcat "\n 本段长度" (rtos dist1 2 2)))
;);================写入Excel
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "a" (itoa row))) 'Value2 pt3)
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "b" (itoa row))) 'Value2 "1")
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "c" (itoa row))) 'Value2 (rtos dist1 2 2))
(grdraw pt p1 1 1)
(if p1
(progn
(setq pts (list p1 pt))
(setq dist1 (distance (car pts) (cadr pts)))
(princ (strcat " 累计长度" (rtos dist1 2 2)))
;;--- 写入Excel ---
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "d" (itoa row))) 'Value2 (rtos dist1 2 2))
(setq row (1+ row)) ;
(setq M 1)
(while (progn
(initget 128 "F")
(setq pt (getpoint p1 "\n 下一点[下一点(N)/重新开始点(F)]: "))
(cond
((= pt "F")
(setq p1 (getpoint "\n 请指定重新开始点: "))
(grdraw pt p1 1 1)
(setq pts (list p1))
(setq dist1 0)
t ; 继续循环
)
(pt
(setq pts (cons pt pts))
(grdraw p1 pt 1 1)
(setq dist2 (distance p1 pt))
(princ (strcat "\n 本段长度" (rtos dist2 2 2)))
(setq dist1 (+ dist1 dist2))
(princ (strcat " 累计长度" (rtos dist1 2 2)))
;;;--- 写入Excel ---
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "a" (itoa row))) 'Value2 pt3)
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "b" (itoa row))) 'Value2 (rtos (1+ M) 2 0))
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "c" (itoa row))) 'Value2 (rtos dist2 2 2))
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "d" (itoa row))) 'Value2 (rtos dist1 2 2))
(setq row (1+ row))
(setq p1 pt)
(setq M (1+ M))
t ; 继续循环
)
(t nil) ; 退出循环
)
))
(princ (strcat "\n（总长度" (rtos dist1 2 0) "）>>>>>>>"))
;(princ (strcat "（共测量了" (rtos (1+ M) 2 0) "条线）"))
(if (zerop dist1)
(princ " 零长度尺寸，请重新测量!")
)
)
)
t ; 继续外层循环
)
nil ; 输入为空则退出外层循环
)
))
(princ)
)
;;;看看是不是你想要的
;可视化测量======每从新 启命令时 就有会从第一行开逐行输入，这样就会掩盖老数据，
(defun c:qqt1234 (/ pt pt3 pt4 ww msg df pts dist1 dist2 p1 excel workbooks workbook worksheet row row-count M)
(setq M 1)
;;;--- 写入Excel ---
(setq row-count 2) ; 初始化Excel行号
(setq excel (vlax-get-or-create-object "Excel.Application"))
(setq workbooks (vlax-get-property excel 'Workbooks))
(if (= (vlax-get-property workbooks 'count) 0)
(setq workbook (vlax-invoke-method workbooks 'Add))
(setq workbook (vlax-get-property workbooks 'item 1))
)
(setq worksheet (vlax-get-property (vlax-get-property workbook 'Worksheets) 'item 1))
;; 获取Excel数据的范围========>>>>>>>>>>>>>>>>>>
(setq excel-range (vlax-get-property worksheet 'UsedRange))
(setq row-count (vlax-get-property (vlax-get-property excel-range 'Rows) 'Count));; 获取行数
(setq col-count (vlax-get-property (vlax-get-property excel-range 'Columns) 'Count));; 获取列数
;;============================>>>>>>>>>>>>>>>>>>
;;;-------------------------------;;;--- 写入Excel --- ;;;--- 首次运行时添加标题行 ---
(vlax-put-property (vlax-get-property worksheet 'Range "A1") 'Value2 "测量名称")
(vlax-put-property (vlax-get-property worksheet 'Range "B1") 'Value2 "线段序号")
(vlax-put-property (vlax-get-property worksheet 'Range "C1") 'Value2 "分段长度")
(vlax-put-property (vlax-get-property worksheet 'Range "D1") 'Value2 "累计长度")
;(setq row 2) ; 初始化Excel行号
(while (progn
; 弹出对话框输入自定义名称
(setq pt3 (getstring T "\n请输入自定测量名称: "))
(if (not (equal pt3 "")) ; 如果输入不为空则继续测量
(progn
(setq pt (getpoint "\n 请指定开始点: "))
(setq p1 (getpoint pt "\n 请指定下一点: "))
(setq dist1 (distance p1 pt))
(princ (strcat "\n 本段长度" (rtos dist1 2 2)))
;);================写入Excel
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "a" (itoa row-count))) 'Value2 pt3)
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "b" (itoa row-count))) 'Value2 "1")
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "c" (itoa row-count))) 'Value2 (rtos dist1 2 2))
(grdraw pt p1 1 1)
(if p1
(progn
(setq pts (list p1 pt))
(setq dist1 (distance (car pts) (cadr pts)))
(princ (strcat " 累计长度" (rtos dist1 2 2)))
;;--- 写入Excel ---
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "d" (itoa row-count))) 'Value2 (rtos dist1 2 2))
(setq row-count (1+ row-count)) ;
(setq M 1)
(while (progn
(initget 128 "F")
(setq pt (getpoint p1 "\n 下一点[下一点(N)/重新开始点(F)]: "))
(cond
((= pt "F")
(setq p1 (getpoint "\n 请指定重新开始点: "))
(grdraw pt p1 1 1)
(setq pts (list p1))
(setq dist1 0)
t ; 继续循环
)
(pt
(setq pts (cons pt pts))
(grdraw p1 pt 1 1)
(setq dist2 (distance p1 pt))
(princ (strcat "\n 本段长度" (rtos dist2 2 2)))
(setq dist1 (+ dist1 dist2))
(princ (strcat " 累计长度" (rtos dist1 2 2)))
;;;--- 写入Excel ---
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "a" (itoa row-count))) 'Value2 pt3)
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "b" (itoa row-count))) 'Value2 (rtos (1+ M) 2 0))
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "c" (itoa row-count))) 'Value2 (rtos dist2 2 2))
(vlax-put-property (vlax-get-property worksheet 'Range (strcat "d" (itoa row-count))) 'Value2 (rtos dist1 2 2))
(setq row-count (1+ row-count))
(setq p1 pt)
(setq M (1+ M))
t ; 继续循环
)
(t nil) ; 退出循环
)
))
(princ (strcat "\n（总长度" (rtos dist1 2 0) "）>>>>>>>"))
;(princ (strcat "（共测量了" (rtos (1+ M) 2 0) "条线）"))
(if (zerop dist1)
(princ " 零长度尺寸，请重新测量!")
)
)
)
t ; 继续外层循环
)
nil ; 输入为空则退出外层循环
)
))
(princ)
)
谢谢师傅辛苦了!
有点小问题加载命令后会吃掉一行 (setq row-count (vlax-get-property (vlax-get-property excel-range 'Rows) 'Count));; 获取行数
修改为：(setq row-count (+ 1 (vlax-get-property (vlax-get-property excel-range 'Rows) 'Count)));; 获取行数+1
页:
[1]