马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
x
工作中,有时候需要按长度的分组统计下线的长度,比如下料的统计等等,下面代码完成这个工作,把线长相同的分成组,然后列出每组的单位长度,总数量,总长度,
最后有总的合计。
 - (defun c:XDTB_TJXIANC (/ h lst scl ss x y)
- (defun my_err (msg)
- (xdrx_prompt "\n" msg)
- (xdrx_pointmonitor)
- (xdrx_end)
- (xd::doc:command (list ".undo" 1))
- (setq *error* nil)
- )
- (if (not #txt_height)
- (setq #txt_height 3.5)
- )
- (if (not #xd_var_global_bits)
- (setq #xd_var_global_bits 1)
- )
- (if (setq val (getint
- (xdrx_prompt "\n保留位数<" #xd_var_global_bits ">:" t)
- )
- )
- (setq #xd_var_global_bits val)
- )
- (if (setq val (getreal (xdrx_prompt "\n字高<" #txt_height ">:" t)))
- (setq #txt_height val)
- )
- (xdrx_initssget "\n选取要统计的线和多段线<退出>:")
- (if (setq ss (xdrx_ssget '((0 . "LINE,*POLYLINE"))))
- (progn (xdrx_begin)
- (xdrx_sysvar_push '("dimzin" 0))
- (setq *error* my_err)
- (setq lst (mapcar '(lambda (x) (list (xdrx_getpropertyvalue x "length") x))
- (xdrx_pickset->ents ss)
- )
- lst (xd::list:groupbyindex lst 1e-3)
- lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
- i 0
- lst (mapcar '(lambda (x)
- (list (itoa (setq i (1+ i)))
- (rtos (car x) 2 #xd_var_global_bits)
- (setq num (length (cdr x)))
- (rtos (* num (car x)) 2 #xd_var_global_bits)
- )
- )
- lst
- )
- lst (append lst
- (list
- (list "合 计"
- (rtos (apply '+ (mapcar '(lambda (y) (atof (cadr y))) lst))
- 2
- #xd_var_global_bits
- )
- (itoa (apply '+ (mapcar '(lambda (y) (caddr y)) lst)))
- (rtos (apply '+ (mapcar '(lambda (y) (atof (last y))) lst))
- 2
- #xd_var_global_bits
- )
- )
- )
- )
- lst (cons (list "序 号" "长 度" "数 量" "总 长") lst)
- lst (cons (list "长度分组统计表" nil nil nil) lst)
- )
- (xd::text:init 1)
- (setq scl (* (xd::var:getratio) (xd::var:getscaleratio))
- h (* #txt_height scl)
- )
- (xd::table:makefromlist lst '(0 0 0) h (/ h 2.0))
- (if (vl-catch-all-error-p
- (vl-catch-all-apply
- 'XD::Drag:SimpleMove
- (list (entlast) "\n表格插入点:" 8 t)
- )
- )
- (xdrx_entity_delete (entlast))
- )
- (xdrx_sysvar_pop)
- (xdrx_end)
- )
- )
- (princ)
- )
|