|
|
- ;;; ===================================================
- ;;; 《长度统计》选择已选则为取消该选择,结果复制到剪切板
- ;;; 作者：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)
- )
|
|
发表于 2024-3-29 22:40:22