明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1086|回复: 11

[源码] 长度统计

  [复制链接]
发表于 2024-2-23 10:32 | 显示全部楼层 |阅读模式
本帖最后由 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)
)

评分

参与人数 3明经币 +3 收起 理由
USER2128 + 1 很给力!
lostbalance + 1 很给力!
xtjd + 1

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

发表于 2024-3-31 08:45 | 显示全部楼层
huxu823 发表于 2024-3-29 22:38
怎么把单位改为m

(princ (strcat "\n  总长 = " (rtos leng) " mm"))
改成(princ (strcat "\n  总长 = " (rtos (/ leng 1000)) " m"))
发表于 2024-3-31 10:47 | 显示全部楼层
Sunderzhao 发表于 2024-3-31 08:45
(princ (strcat "\n  总长 = " (rtos leng) " mm"))
改成(princ (strcat "\n  总长 = " (rtos (/ leng 1 ...

感谢!!
发表于 2024-2-26 11:31 | 显示全部楼层
动态识别长度个数,累积总长度计数,收藏!
发表于 2024-2-23 11:14 | 显示全部楼层
这个挺好用,选定的线条深色显示
发表于 2024-2-23 11:34 | 显示全部楼层
收集了几个类似的,试试楼主的,非常感谢
发表于 2024-2-23 13:39 | 显示全部楼层
只要是“langjs” 的作品,一定要收集的!!!
发表于 2024-2-23 14:37 | 显示全部楼层
感谢大佬分享
发表于 2024-2-24 16:36 | 显示全部楼层
感谢楼主分享。
发表于 2024-3-2 09:33 | 显示全部楼层
感谢lang大师分享。
发表于 2024-3-29 17:39 | 显示全部楼层
感谢lang大师分享。
发表于 2024-3-29 22:38 | 显示全部楼层
怎么把单位改为m
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-4-29 00:33 , Processed in 0.820331 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表