AutoCAD中计算线加总长度
来源:互联网 发布:数据挖掘异常检测算法 编辑:程序博客网 时间:2024/06/13 05:09
;;;-----------------------------------------------------
;;;计算线加总长度
;;;使用方法:命令行中输入:countl
;;;-----------------------------------------------------
(defun C:COUNTL (/ CURVE TLEN SS N SUMLEN)
(vl-load-com)
(setq SUMLEN 0)
(setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
(setq N 0)
(repeat (sslength SS)
(setq CURVE (vlax-ename->vla-object (ssname SS N)))
(setq TLEN (vlax-curve-getdistatparam
CURVE
(vlax-curve-getendparam CURVE)
)
)
(setq SUMLEN (+ SUMLEN TLEN))
(setq N (1+ N))
)
(print (strcat "总长度: " (rtos SUMLEN 2 5)))
(princ)
)
; COUNT.LSP Copyright 1991 Tony Tanzillo All Rights Reserved.计算图块数量
; -----------------------------------------------------------------
;
; Adds the COUNT command to AutoCAD, which counts, itemizes, and displays
; in tabular form, the number of insertions of each block in the selected
; objects, or the entire drawing.
;
; Add to ACAD.LSP, or load with (load"count")
;
; First implemented in May of 1990.
;
; Revision history:
;
; 10/13/1991: General revisions for R11:
;
; 1. Now ignores anonymous blocks and Xrefs.
;
; 2. Added console/screen paging, pauses listing
; at each screen-full and waits for a keypress.
;
; Notes on console paging:
;
; 1. To disable console paging, add the following to COUNT.LSP:
;
; (setq *cpage-disable* t)
;
; 2. The number of physical console lines defaults to 25. This
; can be overridden by adding the following to COUNT.LSP
;
; (setq *console-lines* <num> )
;
; Where <num> is the integer number of physical screen lines.
;
; 3. The screen-clear function defaults to (textpage) under R11,
; and (textscr) under R10 (no screen-clearing is performed),
; but it can be redefined by assigning a function that is to
; be called to do a screen-clear to the symbol *clear-screen*.
;
; The following example can be used with R10 if ANSI.SYS or
; any compatible console-driver is installed, to clear the
; display on each screen-page:
;
; (defun *clear-screen* ()
; (textscr)
; (princ "/e[2J")
; nil
; )
;
; Program listing:
(defun C:COUNT ( / blocks ss)
(princ "/nPress <CR> to select entire drawing or,")
(cond
( (not (setq ss (cond ((ssget))
(t (ssget "x" '((0 . "INSERT")))))))
(princ "/nNo objects selected."))
(t (princ "/nCounting block insertions...")
( (lambda (i)
(repeat i (count_block (ssname ss (setq i (1- i))))))
(sslength ss))
(cond
( (not blocks)
(princ "/nNo block insertions found."))
(t (table-print blocks "Block" "Count" "-" 8 "." nil 'itoa)))))
(princ)
)
(defun table-print (alist title1 title2 headsub coltab padchr
car-form cdr-form / maxlen maxline padstr )
(setq car-form (cond (car-form) (t '(lambda (x) x)))
cdr-form (cond (cdr-form) (t '(lambda (x) x))))
(setq maxlen
(mapcar
'(lambda (pair)
(cons (strlen (car pair))
(strlen (cdr pair))))
(setq alist
(mapcar
'(lambda (pair)
(cons (apply car-form (list (car pair)))
(apply cdr-form (list (cdr pair)))))
alist ))))
(setq maxlen (+ -2 (apply 'max (mapcar 'car maxlen))
(apply 'max (mapcar 'cdr maxlen)))
maxline (+ maxlen coltab)
padstr (repl padchr 70))
(cprinc-init)
(cprinc (strcat title1 " "
(ctab (cons title1 title2)
maxline
(repl " " 70))
" " title2))
(cprinc (repl headsub (+ maxline 2)))
(mapcar
'(lambda (pair)
(cprinc (strcat (car pair) " "
(ctab pair maxline padstr) " "
(cdr pair))))
alist )
)
(defun repl (chr len / res)
(apply 'strcat (repeat len (setq res (cons chr res))))
)
(defun ctab (pair max padstr)
(substr padstr 1 (- max (strlen (car pair) (cdr pair))))
)
(defun cdr++ (key alist)
( (lambda (x)
(cond (x (subst (cons (car x) (1+ (cdr x))) x alist))
(t (cons (cons key 1) alist))))
(assoc key alist))
)
(defun get (k l) (cdr (assoc k l)))
(defun entgetf (k e)
( (lambda (l)
(mapcar '(lambda (x) (cdr (assoc x l))) k))
(entget e))
)
(defun count_block (ename)
(apply
'(lambda (etype name)
(cond
( (and (eq "INSERT" etype)
(or (assoc name blocks)
(zerop (logand 45 (get 70 (tblsearch "block" name)))))
(setq blocks (cdr++ name blocks))))) nil)
(entgetf '(0 2) ename))
)
(defun cprinc-init ()
(setq *console-lines* (cond (*console-lines*) (t 25))
*cprinc-msg* (cond (*cprinc-msg*) (t "--- Press any key ---"))
*cprinc-rubout*
(cond ( (or textpage *clear-screen*) "")
(t (strcat "/r" (repl " " (strlen *cprinc-msg*)) "/r")))
*cprinc-line* -1)
(cond (textpage (textpage))
(*clear-screen* (*clear-screen*))
(t (textscr) (terpri)))
)
(defun cprinc-page ()
(princ *cprinc-msg*)
(grread)
(cond (textpage (textpage))
(*clear-screen* (*clear-screen*))
(t (textscr)))
(princ *cprinc-rubout*)
(setq *cprinc-line* 0)
)
(defun cprinc (s)
(cond ( *cpage-disable*)
( (not *cprinc-line*)
(cprinc-init))
( (eq (setq *cprinc-line* (1+ *cprinc-line*))
(1- *console-lines*))
(cprinc-page)))
(write-line s)
)
; ############################ eof COUNT.LSP ################################
- AutoCAD中计算线加总长度
- MySQL中计算索引长度
- 在autocad中计算曲线要素的lisp程序。
- AutoCAD中如何计算二维图形的面积
- 计算控件中字体的长度
- MySQL中varchar最大长度计算
- js中计算中文长度方法(转)
- C语言中计算一个数组长度
- java中计算字符串长度的方法
- JS中计算字符串的长度
- C++中数组长度的计算
- iOS中动态计算字符串的长度
- objective-c中字符串长度计算
- smarty模板中计算数组长度
- opencv3计算图像中轮廓的长度
- c语言中数组长度的计算
- NSString 中计算字符串长度的方法
- JS中计算字符串UTF-8长度
- 域清单模式:企业成功实施SOA的最佳手段
- Axure RP Pro - jQuery - How to implement the "set focus" action
- 排序算法
- 从激情到平淡到失望,从无知无畏到畏首畏尾,不知什么时候我才能成熟面对人生百态
- 记忆中的程序设计题目
- AutoCAD中计算线加总长度
- shared_ptr.hpp(321) : error C2039: 'type_info' : is not a member of 'std' 错误修正
- 相遇在世界尽头与冷酷仙境
- interbase "Cannot attach to password database"错误解决一例
- 基于Struts FormFile上传文件
- EXCLE的两个简单宏脚本
- linux编译 clucene
- jquery简单体验
- 代友求职:网页设计、网页制作,网络编辑