长风（尚品） 发表于 2013-1-9 09:46:25

谁帮忙修改源码？

这是一段标注面积周长的源码.去掉中间重复数字，另外在面积后面加一个平方米的符号。谢谢
;;; revision .....
(defun strlcat (lst delim)
(apply 'strcat
(cons
(car lst)
(mapcar
(function (lambda (x) (strcat delim x)))
(cdr lst)
) ) )
)
;; for Test only
(defun c:mjzc (/ pt ee qArea qZc SumA SumL rSumA rSumL)
;;
;; (setq olderr *error*)
;; (setq *error* myerr)
; (setvar "cmdecho" 0)
;;(setq oldos (getvar "osmode"))
;;
(setvar "osmode" 0)
(while (setq ee (entsel))
(setq ee (car ee))
(command "area" "o" ee)
(setq qarea (getvar "area")
qZc (getvar "perimeter")
SumA (cons (* qArea 0.0001) SumA)

SumL (cons (* qZc 0.01) SumL)
) )
;; 总面积=
;; (0.607612 0.408547 0.337764)
(setVar "Luprec" 2); 计
(setq rSumA (apply '+ SumA)
   rSumL (apply '+ SumL)
SumA (StrlCat (mapcar 'rtos SumA) "+")
SumL (StrlCat (mapcar 'rtos SumL) "+")
)
(setq pt (getpoint "\n确认标注位置"))
;; (setq pt (getpoint"\n确认标注位置"))
(command "text""None" pt "" ""
(strcat
"总面积="
SumA
"="
(rtos rSumA)
"") )
;; 周长
(command "text" "None"
(polar pt (* Pi 1.5) (* (GetVar "TextSize") 2))
"" ""
(strcat
"周长="
SumL
"="
(rtos rSumL)
"m") )
(setvar "osmode" 1)
)

004 发表于 2013-1-9 10:38:12

本帖最后由 004 于 2013-1-9 10:38 编辑


;;; revision .....

(defun strlcat (lst delim)
(apply
    'strcat
    (cons (car lst)
          (mapcar (function (lambda (x) (strcat delim x))) (cdr lst))
    )
)
)
;; for Test only
(defun c:mjzc (/ pt ee qArea qZc SumA SumL rSumA rSumL)
;;
;; (setq olderr *error*)
;; (setq *error* myerr)
                                        ; (setvar "cmdecho" 0)
;;(setq oldos (getvar "osmode"))
;;
(setvar "osmode" 0)
(while (setq ee (entsel))
    (setq ee (car ee))
    (command "area" "o" ee)
    (setq qarea      (getvar "area")
          qZc      (getvar "perimeter")
          SumA      (cons (* qArea 0.0001) SumA)
          SumL      (cons (* qZc 0.01) SumL)
    )
)
(if Suml
    (progn ;; 总面积=
         ;; (0.607612 0.408547 0.337764)
         (setVar "Luprec" 2)                ; ?计?
         (setq rSumA (apply '+ SumA)
               rSumL (apply '+ SumL)
               SumA(StrlCat (mapcar 'rtos SumA) "+")
               SumL(StrlCat (mapcar 'rtos SumL) "+")
         )
         (setq pt (getpoint "\n确认标注位置"))
         ;; (setq pt (getpoint"\n确认标注位置"))
         (command "text"
                  "None"
                  pt
                  ""
                  ""
                  (strcat "总面积=" (rtos rSumA) "㎡")
         )
         ;; 周长??
         (command "text"
                  "None"
                  (polar pt (* Pi 1.5) (* (GetVar "TextSize") 2))
                  ""
                  ""
                  (strcat "周长=" (rtos rSumL) "m")
         )
         (setvar "osmode" 1)
    )
    (princ "\n选择错误")
)
(princ)
)

长风（尚品） 发表于 2013-1-10 11:24:48

004 发表于 2013-1-9 10:38 static/image/common/back.gif


感谢004 的帮忙
页: [1]
查看完整版本: 谁帮忙修改源码？