长度统计

langjs · 发表于 2024-2-23 10:32:36

本帖最后由 langjs 于 2024-2-26 22:23 编辑

;;; ===================================================
;;; 《长度统计》选择已选则为取消该选择,结果复制到剪切板
;;; 作者：langjs
;;; ===================================================
(defun c:cdtj (/ co html i len leng lst lwd n name obj result ss str)
  (defun #err (s / n obj)             ; 出错处理子函数
(foreach n lst
   (setq obj (vlax-ename->vla-object (car n)))
   (vla-put-color obj (last n)) (vla-put-lineweight obj aclnwt000))
(setvar "LWDISPLAY" lwd) (setvar "nomutt" 0)
((if command-s command-s  vl-cmdf ) ".UNDO" "E" )
(setq *error* $orr)) (vl-load-com)
  (setvar "cmdecho" 0)  (setq lwd (getvar "LWDISPLAY"))
  (vl-cmdf ".UNDO" "BE")  (setvar "nomutt" 1)
  (setq $orr *error* *error* #err  lst '() leng 0.0 )
  (princ "\n  《长度统计》，选择已选则为取消该选择。")
  (while (setq ss (setq ss (ssget ":S" '((0 . "LINE,CIRCLE,ARC,ELLIPSE,LWPOLYLINE,POLYLINE,SPLINE")))))
(setvar "LWDISPLAY" 1)
(repeat (setq i (sslength ss))
   (setq name (ssname ss (setq i (1- i)))  obj (vlax-ename->vla-object name))
   (if (setq n (assoc name lst))
      (progn (setq lst (vl-remove n lst) leng (- leng (cadr n)))
      (vla-put-color obj (last n)) (vla-put-lineweight obj aclnwt000))
      (progn  (setq co (vla-get-color obj) len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
            leng (+ leng len) lst (cons (list name len co) lst))
      (vla-put-color obj 60)  (vla-put-lineweight obj aclnwt060))))
(princ (strcat "\n  总长 = " (rtos leng) " mm"))
(setq str (rtos leng) html (vlax-create-object "htmlfile")
      result (vlax-invoke (vlax-get (vlax-get html 'parentwindow) 'clipboarddata) 'setdata "Text" str))
(vlax-release-object html))
  (foreach n lst
(setq obj (vlax-ename->vla-object (car n)))
(vla-put-color obj (last n))(vla-put-lineweight obj aclnwt000))
  (setvar "LWDISPLAY" lwd)  (setvar "nomutt" 0)
  (vl-cmdf ".UNDO" "E")  (setq *error* $orr)
  (princ)
)

Sunderzhao · 发表于 2024-3-31 08:45:18

huxu823 发表于 2024-3-29 22:38
怎么把单位改为m

(princ (strcat "\n 总长 = " (rtos leng) " mm"))
改成(princ (strcat "\n 总长 = " (rtos (/ leng 1000)) " m"))

huxu823 · 发表于 2024-3-31 10:47:45

Sunderzhao 发表于 2024-3-31 08:45
(princ (strcat "\n 总长 = " (rtos leng) " mm"))
改成(princ (strcat "\n 总长 = " (rtos (/ leng 1 ...

感谢！！

JANHNG · 发表于 2024-2-23 11:14:36

这个挺好用，选定的线条深色显示

shirker · 发表于 2024-2-23 11:34:21

收集了几个类似的，试试楼主的，非常感谢

panliang9 · 发表于 2024-2-23 13:39:31

只要是“langjs” 的作品，一定要收集的！！！

magicheno · 发表于 2024-2-23 14:37:37

感谢大佬分享

khadwf · 发表于 2024-2-24 16:36:54

感谢楼主分享。

jkop · 发表于 2024-2-26 11:31:41

动态识别长度个数，累积总长度计数，收藏！

Noangler · 发表于 2024-3-2 09:33:16

感谢lang大师分享。

479274135 · 发表于 2024-3-29 17:39:03

感谢lang大师分享。

huxu823 · 发表于 2024-3-29 22:38:46

怎么把单位改为m

账号		自动登录	找回密码
密码			注册

[源码] 长度统计

评分

本帖被以下淘专辑推荐: