可视化测量动态输入到excel表

758586

各位大老好，有个问题需要请大老们帮助修改，

功能是:在图上测量距离动态输入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)
)

758586

谢谢师傅辛苦了!
有点小问题加载命令后会吃掉一行

技术工作室

(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