求大神写个算面积能列式的插件小弟谢谢了

huopojinshu · 发表于 2015-3-9 00:29:27

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

求大神写个算面积能列式的插件小弟谢谢了

aeo · 发表于 2015-3-31 15:58:46

auva 发表于 2015-3-9 21:20

你这扇形公式对吗？

huopojinshu · 发表于 2015-3-9 00:38:29

能算列式4边形或者3边形就好了

auva · 发表于 2015-3-9 21:20:59

本帖最后由 auva 于 2015-3-31 21:07 编辑

(princ
"\n====================================================================="
)
(princ "\n命令：bmz")
(princ "\n功能：標示分割區域面積計算公式及值")
(princ
"\n功能：可標示：圓、弓形、扇形、三角形、矩形、平形四邊形及梯形等 7 種"
)
(princ
"\n by Atsai 2013.05.31"
)
(princ
"\n====================================================================="
)
(defun c:bmz (/ os dimzin th no lst area_lst
en1 en2 en3 en4 pt i l pt_lst
gx_lst gx obj2
)
(vl-load-com)
(setq os (getvar "osmode"))
(setq dimzin (getvar "dimzin"))
(setvar "osmode" 0)
(setvar "dimzin" 0)
(setvar "cmdecho" 0)
(setq th (getreal "\n請輸入文字高度:<1.0>"))
(if (= th nil)
(setq th 1.0)
)
(setq no 1)
(setq lst '())
(setq area_lst '())
(while
(setq pt (getpoint "\n請選點:"))
(setq d1 3)
(setq d2 3)
(command "-boundary" pt "")
(setq en1 (entlast))
(pt&tudo en1)
(setq l (length pt_lst))
(if (= l 4.0)
(progn
(setq ang1 (angle (nth 0 pt_lst) (nth 1 pt_lst)))
(setq ang2 (angle (nth 1 pt_lst) (nth 2 pt_lst)))
(setq ang12 (- ang2 ang1))
(setq int13 (inters (nth 0 pt_lst)
(nth 1 pt_lst)
(nth 2 pt_lst)
(nth 3 pt_lst)
nil
)
)
(setq int24 (inters (nth 1 pt_lst)
(nth 2 pt_lst)
(nth 3 pt_lst)
(nth 0 pt_lst)
nil
)
)
)
)
(setq gx (apply 'max gx_lst))
(command "_region" en1 "")
(setq en2 (entlast))
(setq obj2 nil)
(setq obj2 (vlax-ename->vla-object en2))
(setq ptc (vlax-safearray->list
(vlax-variant-value (vla-get-centroid obj2))
)
) ;質心
(setq area (vla-get-Area obj2)) ;面積
(command "erase" en1 en2 "")
(command "text" "j" "mc" ptc th "0" no)
(setq en3 (entlast))
(command "circle" ptc th)
(setq en4 (entlast))
(setq lst-temp '())
(setq IA nil)
(setq xc nil)
(setq R nil)
(cond
((and (= l 2.0) (= (nth 0 gx_lst) (nth 1 gx_lst)))
(setq IA (* (atan (abs gx)) 4))
(setq xc (* 0.5 (distance (nth 0 pt_lst) (nth 1 pt_lst))))
(setq R (/ xc (sin (/ IA 2))))
(setq
lst-temp (strcat "π*" (rtos R 2 d1) "^2=" (rtos area 2 d2))
)
(setq lst (append lst (list lst-temp)))
(setq area_lst (append area_lst (list area)))
) ;圓形
((and (= l 2.0) (/= (nth 0 gx_lst) (nth 1 gx_lst)))
(setq IA (* (atan (abs gx)) 4))
(setq xc (* 0.5 (distance (nth 0 pt_lst) (nth 1 pt_lst))))
(setq R (/ xc (sin (/ IA 2))))
(setq lst-temp (strcat "1/2*"
(rtos R 2 d1)
"^2*("
(rtos IA 2 d1)
"-sin("
(rtos IA 2 d1)
"))="
(rtos area 2 d2)
)
)
(setq lst (append lst (list lst-temp)))
(setq area_lst (append area_lst (list area)))
) ;弓形
((and (= l 3.0) (= gx 0.0))
(setq a (distance (nth 0 pt_lst) (nth 1 pt_lst)))
(setq b (distance (nth 1 pt_lst) (nth 2 pt_lst)))
(setq c (distance (nth 2 pt_lst) (nth 0 pt_lst)))
(setq s (* 0.5 (+ a b c)))
(setq lst-temp
(strcat "sqrt("
(rtos s 2 d1)
"*("
(rtos s 2 d1)
"-"
(rtos a 2 d1)
")"
"*("
(rtos s 2 d1)
"-"
(rtos b 2 d1)
")"
"*("
(rtos s 2 d1)
"-"
(rtos c 2 d1)
"))="
(rtos area 2 d2)
)
)
(setq lst (append lst (list lst-temp)))
(setq area_lst (append area_lst (list area)))
) ;三角形
((and (= l 3.0) (/= gx 0.0))
(setq IA (* (atan (abs gx)) 4))
;这里出错了，第一、二点并不一定是弦长！
;(setq xc (* 0.5 (distance (nth 0 pt_lst) (nth 1 pt_lst))))
;(setq R (/ xc (sin (/ IA 2))))
;这里出错了，第一、二点并不一定是弦长！
;改成这样就好了！
(cond ((equal (distance (nth 0 pt_lst) (nth 1 pt_lst))
(distance (nth 1 pt_lst) (nth 2 pt_lst))
1e-6
)
(setq R (distance (nth 0 pt_lst) (nth 1 pt_lst)))
)
((equal (distance (nth 1 pt_lst) (nth 2 pt_lst))
(distance (nth 2 pt_lst) (nth 0 pt_lst))
1e-6
)
(setq R (distance (nth 1 pt_lst) (nth 2 pt_lst)))
)
((equal (distance (nth 2 pt_lst) (nth 0 pt_lst))
(distance (nth 0 pt_lst) (nth 1 pt_lst))
1e-6
)
(setq R (distance (nth 2 pt_lst) (nth 0 pt_lst)))
)
)
;改成这样就好了！
(setq lst-temp (strcat "1/2*"
(rtos R 2 d1)
"^2*"
(rtos IA 2 d1)
"="
(rtos area 2 d2)
)
)
(setq lst (append lst (list lst-temp)))
(setq area_lst (append area_lst (list area)))
) ;扇形
((and (= l 4.0)
(= int13 nil)
(= int24 nil)
(= (abs ang12) (* 0.5 pi))
)
(setq a (distance (nth 0 pt_lst) (nth 1 pt_lst)))
(setq b (distance (nth 1 pt_lst) (nth 2 pt_lst)))
(setq lst-temp (strcat (rtos a 2 d1)
"*"
(rtos b 2 d1)
"="
(rtos area 2 d2)
)
)
(setq lst (append lst (list lst-temp)))
(setq area_lst (append area_lst (list area)))
) ;矩形
((and (= l 4.0)
(= int13 nil)
(= int24 nil)
(/= (abs ang12) (* 0.5 pi))
)
(setq a (distance (nth 0 pt_lst) (nth 1 pt_lst)))
(setq a1 (- (cadr (nth 2 pt_lst)) (cadr (nth 3 pt_lst))))
(setq b1 (- (car (nth 3 pt_lst)) (car (nth 2 pt_lst))))
(setq c1 (- (* (cadr (nth 2 pt_lst))
(- (car (nth 2 pt_lst)) (car (nth 3 pt_lst)))
)
(* (car (nth 2 pt_lst))
(- (cadr (nth 2 pt_lst)) (cadr (nth 3 pt_lst)))
)
)
)
(setq l1 (sqrt (+ (* a1 a1) (* b1 b1))))
(setq
l2 (+ (* a1 (car (nth 0 pt_lst)))
(* b1 (cadr (nth 0 pt_lst)))
c1
)
)
(setq b (/ (abs l2) l1))
(setq lst-temp (strcat (rtos a 2 d1)
"*"
(rtos b 2 d1)
"="
(rtos area 2 d2)
)
)
(setq lst (append lst (list lst-temp)))
(setq area_lst (append area_lst (list area)))
) ;平行四邊形
((and (= l 4.0)
(= int13 nil)
(/= int24 nil)
)
(setq a (distance (nth 0 pt_lst) (nth 1 pt_lst)))
(setq b (distance (nth 2 pt_lst) (nth 3 pt_lst)))
(setq a1 (- (cadr (nth 2 pt_lst)) (cadr (nth 3 pt_lst))))
(setq b1 (- (car (nth 3 pt_lst)) (car (nth 2 pt_lst))))
(setq c1 (- (* (cadr (nth 2 pt_lst))
(- (car (nth 2 pt_lst)) (car (nth 3 pt_lst)))
)
(* (car (nth 2 pt_lst))
(- (cadr (nth 2 pt_lst)) (cadr (nth 3 pt_lst)))
)
)
)
(setq l1 (sqrt (+ (* a1 a1) (* b1 b1))))
(setq
l2 (+ (* a1 (car (nth 0 pt_lst)))
(* b1 (cadr (nth 0 pt_lst)))
c1
)
)
(setq c (/ (abs l2) l1))
(setq lst-temp (strcat "1/2*("
(rtos a 2 d1)
"+"
(rtos b 2 d1)
")*"
(rtos c 2 d1)
"="
(rtos area 2 d2)
)
)
(setq lst (append lst (list lst-temp)))
(setq area_lst (append area_lst (list area)))
) ;梯形1
((and (= l 4.0)
(/= int13 nil)
(= int24 nil)
)
(setq a (distance (nth 1 pt_lst) (nth 2 pt_lst)))
(setq b (distance (nth 3 pt_lst) (nth 0 pt_lst)))
(setq a1 (- (cadr (nth 3 pt_lst)) (cadr (nth 0 pt_lst))))
(setq b1 (- (car (nth 0 pt_lst)) (car (nth 3 pt_lst))))
(setq c1 (- (* (cadr (nth 3 pt_lst))
(- (car (nth 3 pt_lst)) (car (nth 0 pt_lst)))
)
(* (car (nth 3 pt_lst))
(- (cadr (nth 3 pt_lst)) (cadr (nth 0 pt_lst)))
)
)
)
(setq l1 (sqrt (+ (* a1 a1) (* b1 b1))))
(setq
l2 (+ (* a1 (car (nth 1 pt_lst)))
(* b1 (cadr (nth 1 pt_lst)))
c1
)
)
(setq c (/ (abs l2) l1))
(setq lst-temp (strcat "1/2*("
(rtos a 2 d1)
"+"
(rtos b 2 d1)
")*"
(rtos c 2 d1)
"="
(rtos area 2 d2)
)
)
(setq lst (append lst (list lst-temp)))
(setq area_lst (append area_lst (list area)))
) ;梯形2
((and (= l 4.0)
(/= int13 nil)
(/= int24 nil)
)
(princ "請重選")
(command "erase" en3 en4 "")
(setq no (- no 1))
)
((and (> l 4.0)
)
(princ "請重選")
(command "erase" en3 en4 "")
(setq no (- no 1))
)
)
(setq no (1+ no))
) ;end while
(setq pt1 (getpoint "\n請選擇面積列表插入點:"))
(setq i 0)
(setq sumarea 0.0)
(repeat (length lst)
(setq pt2 (polar pt1 (* 1.5 pi) (* (* 2.0 i) th)))
(command "text"
"j"
"bl"
pt2
th
"0"
(strcat "No" (rtos (1+ i) 2 0) ": " (nth i lst) "m2")
)
(setq sumarea (+ sumarea (nth i area_lst)))
(setq i (1+ i))
)
(setq pt2 (polar pt1 (* 1.5 pi) (* (* 2.0 i) th)))
(command "text"
"j"
"bl"
pt2
th
"0"
(strcat "Σ area=" (rtos sumarea 2 d2) "m2")
)
(setvar "dimzin" dimzin)
(setvar "osmode" os)
(princ)
)
;;;==========副程式pt&tudo，start===============
(defun pt&tudo (en / i nn pt)
(setq endata (entget en)
pt_lst '()
gx_lst '()
)
(setq i 0)
(repeat (length endata)
(setq nn (nth i endata))
(cond ((= (car nn) 10)
(setq pt (cdr nn))
(setq pt_lst (append pt_lst (list pt)))
)
((= (car nn) 42)
(setq gx (cdr nn))
(setq gx_lst (append gx_lst (list gx)))
)
)
(setq i (1+ i))
)
(setq i 0)
(setq l (length pt_lst))
(if (> l 3)
(progn
(repeat l
(cond ((< (+ i 2) l)
(setq x1 (car (nth i pt_lst)))
(setq y1 (cadr (nth i pt_lst)))
(setq x2 (car (nth (+ i 1) pt_lst)))
(setq y2 (cadr (nth (+ i 1) pt_lst)))
(setq x3 (car (nth (+ i 2) pt_lst)))
(setq y3 (cadr (nth (+ i 2) pt_lst)))
(setq
xs
(- (* (- y3 y1) (- x2 x1)) (* (- x3 x1) (- y2 y1)))
)
(if
(< (abs xs) 1e-6)
(progn
(setq pt_lst (vl-remove (nth (+ i 1) pt_lst) pt_lst))
(setq l (length pt_lst))
(setq i (- i 1))
)
)
)
((= (+ i 2) l)
(setq x1 (car (nth i pt_lst)))
(setq y1 (cadr (nth i pt_lst)))
(setq x2 (car (nth (+ i 1) pt_lst)))
(setq y2 (cadr (nth (+ i 1) pt_lst)))
(setq x3 (car (nth 0 pt_lst)))
(setq y3 (cadr (nth 0 pt_lst)))
(setq
xs
(- (* (- y3 y1) (- x2 x1)) (* (- x3 x1) (- y2 y1)))
)
(if
(< (abs xs) 1e-6)
(progn
(setq pt_lst (vl-remove (nth (+ i 1) pt_lst) pt_lst))
(setq l (length pt_lst))
(setq i (- i 1))
)
)
)
((= (+ i 1) l)
(setq x1 (car (nth i pt_lst)))
(setq y1 (cadr (nth i pt_lst)))
(setq x2 (car (nth 0 pt_lst)))
(setq y2 (cadr (nth 0 pt_lst)))
(setq x3 (car (nth 1 pt_lst)))
(setq y3 (cadr (nth 1 pt_lst)))
(setq
xs
(- (* (- y3 y1) (- x2 x1)) (* (- x3 x1) (- y2 y1)))
)
(if
(< (abs xs) 1e-6)
(progn
(setq pt_lst (vl-remove (nth 0 pt_lst) pt_lst))
(setq l (length pt_lst))
(setq i (- i 1))
)
)
)
)
(setq i (1+ i))
)
)
)
)
;;;==========副程式pt&tudo，end===============

(princ 
  "\n=====================================================================" 
) 
(princ "\n命令：bmz") 
(princ "\n功能：標示分割區域面積計算公式及值") 
(princ 
  "\n功能：可標示：圓、弓形、扇形、三角形、矩形、平形四邊形及梯形等 7 種" 
) 
(princ 
  "\n               by Atsai 2013.05.31" 
) 
(princ 
  "\n=====================================================================" 
) 
 
 
(defun c:bmz (/             os            dimzin th          no         lst        area_lst 
              en1    en2    en3           en4          pt         i        l      pt_lst 
              gx_lst gx            obj2 
             ) 
  (vl-load-com) 
  (setq os (getvar "osmode")) 
  (setq dimzin (getvar "dimzin")) 
  (setvar "osmode" 0) 
  (setvar "dimzin" 0) 
  (setvar "cmdecho" 0) 
  (setq th (getreal "\n請輸入文字高度:<1.0>")) 
  (if (= th nil) 
    (setq th 1.0) 
  ) 
  (setq no 1) 
  (setq lst '()) 
  (setq area_lst '()) 
  (while 
    (setq pt (getpoint "\n請選點:")) 
     (setq d1 3) 
     (setq d2 3) 
     (command "-boundary" pt "") 
     (setq en1 (entlast)) 
     (pt&tudo en1) 
     (setq l (length pt_lst)) 
     (if (= l 4.0) 
       (progn 
         (setq ang1 (angle (nth 0 pt_lst) (nth 1 pt_lst))) 
         (setq ang2 (angle (nth 1 pt_lst) (nth 2 pt_lst))) 
         (setq ang12 (- ang2 ang1)) 
         (setq int13 (inters (nth 0 pt_lst) 
                             (nth 1 pt_lst) 
                             (nth 2 pt_lst) 
                             (nth 3 pt_lst) 
                             nil 
                     ) 
         ) 
         (setq int24 (inters (nth 1 pt_lst) 
                             (nth 2 pt_lst) 
                             (nth 3 pt_lst) 
                             (nth 0 pt_lst) 
                             nil 
                     ) 
         ) 
       ) 
     ) 
     (setq gx (apply 'max gx_lst)) 
 
     (command "_region" en1 "") 
     (setq en2 (entlast)) 
     (setq obj2 nil) 
     (setq obj2 (vlax-ename->vla-object en2)) 
     (setq ptc (vlax-safearray->list 
                 (vlax-variant-value (vla-get-centroid obj2)) 
               ) 
     )                                        ;質心 
     (setq area (vla-get-Area obj2))        ;面積 
 
     (command "erase" en1 en2 "") 
     (command "text" "j" "mc" ptc th "0" no) 
     (setq en3 (entlast)) 
     (command "circle" ptc th) 
     (setq en4 (entlast)) 
     (setq lst-temp '()) 
     (setq IA nil) 
     (setq xc nil) 
     (setq R nil) 
     (cond 
       ((and (= l 2.0) (= (nth 0 gx_lst) (nth 1 gx_lst))) 
        (setq IA (* (atan (abs gx)) 4)) 
        (setq xc (* 0.5 (distance (nth 0 pt_lst) (nth 1 pt_lst)))) 
        (setq R (/ xc (sin (/ IA 2)))) 
        (setq 
          lst-temp (strcat "π*" (rtos R 2 d1) "^2=" (rtos area 2 d2)) 
        ) 
        (setq lst (append lst (list lst-temp))) 
        (setq area_lst (append area_lst (list area))) 
       )                                ;圓形 
 
       ((and (= l 2.0) (/= (nth 0 gx_lst) (nth 1 gx_lst))) 
        (setq IA (* (atan (abs gx)) 4)) 
        (setq xc (* 0.5 (distance (nth 0 pt_lst) (nth 1 pt_lst)))) 
        (setq R (/ xc (sin (/ IA 2)))) 
        (setq lst-temp (strcat "1/2*" 
                               (rtos R 2 d1) 
                               "^2*(" 
                               (rtos IA 2 d1) 
                               "-sin(" 
                               (rtos IA 2 d1) 
                               "))=" 
                               (rtos area 2 d2) 
                       ) 
        ) 
        (setq lst (append lst (list lst-temp))) 
        (setq area_lst (append area_lst (list area))) 
       )                                ;弓形 
 
       ((and (= l 3.0) (= gx 0.0)) 
        (setq a (distance (nth 0 pt_lst) (nth 1 pt_lst))) 
        (setq b (distance (nth 1 pt_lst) (nth 2 pt_lst))) 
        (setq c (distance (nth 2 pt_lst) (nth 0 pt_lst))) 
        (setq s (* 0.5 (+ a b c))) 
        (setq lst-temp 
               (strcat "sqrt(" 
                       (rtos s 2 d1) 
                       "*(" 
                       (rtos s 2 d1) 
                       "-" 
                       (rtos a 2 d1) 
                       ")" 
                       "*(" 
                       (rtos s 2 d1) 
                       "-" 
                       (rtos b 2 d1) 
                       ")" 
                       "*(" 
                       (rtos s 2 d1) 
                       "-" 
                       (rtos c 2 d1) 
                       "))=" 
                       (rtos area 2 d2) 
               ) 
        ) 
        (setq lst (append lst (list lst-temp))) 
        (setq area_lst (append area_lst (list area))) 
       )                                ;三角形 
       ((and (= l 3.0) (/= gx 0.0)) 
        (setq IA (* (atan (abs gx)) 4)) 
 
        ;这里出错了，第一、二点并不一定是弦长！ 
        ;(setq xc (* 0.5 (distance (nth 0 pt_lst) (nth 1 pt_lst)))) 
        ;(setq R (/ xc (sin (/ IA 2)))) 
        ;这里出错了，第一、二点并不一定是弦长！ 
 
        ;改成这样就好了！ 
        (cond ((equal (distance (nth 0 pt_lst) (nth 1 pt_lst)) 
                      (distance (nth 1 pt_lst) (nth 2 pt_lst)) 
                      1e-6 
               ) 
               (setq R (distance (nth 0 pt_lst) (nth 1 pt_lst))) 
              ) 
              ((equal (distance (nth 1 pt_lst) (nth 2 pt_lst)) 
                      (distance (nth 2 pt_lst) (nth 0 pt_lst)) 
                      1e-6 
               ) 
               (setq R (distance (nth 1 pt_lst) (nth 2 pt_lst))) 
              ) 
              ((equal (distance (nth 2 pt_lst) (nth 0 pt_lst)) 
                      (distance (nth 0 pt_lst) (nth 1 pt_lst)) 
                      1e-6 
               ) 
               (setq R (distance (nth 2 pt_lst) (nth 0 pt_lst))) 
              ) 
        ) 
        ;改成这样就好了！ 
 
        (setq lst-temp (strcat "1/2*" 
                               (rtos R 2 d1) 
                               "^2*" 
                               (rtos IA 2 d1) 
                               "=" 
                               (rtos area 2 d2) 
                       ) 
        ) 
        (setq lst (append lst (list lst-temp))) 
        (setq area_lst (append area_lst (list area))) 
       )                                ;扇形 
 
       ((and (= l 4.0) 
             (= int13 nil) 
             (= int24 nil) 
             (= (abs ang12) (* 0.5 pi)) 
        ) 
        (setq a (distance (nth 0 pt_lst) (nth 1 pt_lst))) 
        (setq b (distance (nth 1 pt_lst) (nth 2 pt_lst))) 
        (setq lst-temp (strcat (rtos a 2 d1) 
                               "*" 
                               (rtos b 2 d1) 
                               "=" 
                               (rtos area 2 d2) 
                       ) 
        ) 
        (setq lst (append lst (list lst-temp))) 
        (setq area_lst (append area_lst (list area))) 
       )                                ;矩形 
 
       ((and (= l 4.0) 
             (= int13 nil) 
             (= int24 nil) 
             (/= (abs ang12) (* 0.5 pi)) 
        ) 
        (setq a (distance (nth 0 pt_lst) (nth 1 pt_lst))) 
        (setq a1 (- (cadr (nth 2 pt_lst)) (cadr (nth 3 pt_lst)))) 
        (setq b1 (- (car (nth 3 pt_lst)) (car (nth 2 pt_lst)))) 
        (setq c1 (- (* (cadr (nth 2 pt_lst)) 
                       (- (car (nth 2 pt_lst)) (car (nth 3 pt_lst))) 
                    ) 
                    (* (car (nth 2 pt_lst)) 
                       (- (cadr (nth 2 pt_lst)) (cadr (nth 3 pt_lst))) 
                    ) 
                 ) 
        ) 
        (setq l1 (sqrt (+ (* a1 a1) (* b1 b1)))) 
        (setq 
          l2 (+        (* a1 (car (nth 0 pt_lst))) 
                (* b1 (cadr (nth 0 pt_lst))) 
                c1 
             ) 
        ) 
        (setq b (/ (abs l2) l1)) 
        (setq lst-temp (strcat (rtos a 2 d1) 
                               "*" 
                               (rtos b 2 d1) 
                               "=" 
                               (rtos area 2 d2) 
                       ) 
        ) 
        (setq lst (append lst (list lst-temp))) 
        (setq area_lst (append area_lst (list area))) 
       )                                ;平行四邊形 
 
       ((and (= l 4.0) 
             (= int13 nil) 
             (/= int24 nil) 
        ) 
        (setq a (distance (nth 0 pt_lst) (nth 1 pt_lst))) 
        (setq b (distance (nth 2 pt_lst) (nth 3 pt_lst))) 
        (setq a1 (- (cadr (nth 2 pt_lst)) (cadr (nth 3 pt_lst)))) 
        (setq b1 (- (car (nth 3 pt_lst)) (car (nth 2 pt_lst)))) 
        (setq c1 (- (* (cadr (nth 2 pt_lst)) 
                       (- (car (nth 2 pt_lst)) (car (nth 3 pt_lst))) 
                    ) 
                    (* (car (nth 2 pt_lst)) 
                       (- (cadr (nth 2 pt_lst)) (cadr (nth 3 pt_lst))) 
                    ) 
                 ) 
        ) 
        (setq l1 (sqrt (+ (* a1 a1) (* b1 b1)))) 
        (setq 
          l2 (+        (* a1 (car (nth 0 pt_lst))) 
                (* b1 (cadr (nth 0 pt_lst))) 
                c1 
             ) 
        ) 
        (setq c (/ (abs l2) l1)) 
        (setq lst-temp (strcat "1/2*(" 
                               (rtos a 2 d1) 
                               "+" 
                               (rtos b 2 d1) 
                               ")*" 
                               (rtos c 2 d1) 
                               "=" 
                               (rtos area 2 d2) 
                       ) 
        ) 
        (setq lst (append lst (list lst-temp))) 
        (setq area_lst (append area_lst (list area))) 
       )                                ;梯形1 
 
       ((and (= l 4.0) 
             (/= int13 nil) 
             (= int24 nil) 
        ) 
        (setq a (distance (nth 1 pt_lst) (nth 2 pt_lst))) 
        (setq b (distance (nth 3 pt_lst) (nth 0 pt_lst))) 
        (setq a1 (- (cadr (nth 3 pt_lst)) (cadr (nth 0 pt_lst)))) 
        (setq b1 (- (car (nth 0 pt_lst)) (car (nth 3 pt_lst)))) 
        (setq c1 (- (* (cadr (nth 3 pt_lst)) 
                       (- (car (nth 3 pt_lst)) (car (nth 0 pt_lst))) 
                    ) 
                    (* (car (nth 3 pt_lst)) 
                       (- (cadr (nth 3 pt_lst)) (cadr (nth 0 pt_lst))) 
                    ) 
                 ) 
        ) 
 
        (setq l1 (sqrt (+ (* a1 a1) (* b1 b1)))) 
        (setq 
          l2 (+        (* a1 (car (nth 1 pt_lst))) 
                (* b1 (cadr (nth 1 pt_lst))) 
                c1 
             ) 
        ) 
        (setq c (/ (abs l2) l1)) 
        (setq lst-temp (strcat "1/2*(" 
                               (rtos a 2 d1) 
                               "+" 
                               (rtos b 2 d1) 
                               ")*" 
                               (rtos c 2 d1) 
                               "=" 
                               (rtos area 2 d2) 
                       ) 
        ) 
        (setq lst (append lst (list lst-temp))) 
        (setq area_lst (append area_lst (list area))) 
       )                                ;梯形2 
 
       ((and (= l 4.0) 
             (/= int13 nil) 
             (/= int24 nil) 
        ) 
        (princ "請重選") 
        (command "erase" en3 en4 "") 
        (setq no (- no 1)) 
       ) 
       ((and (> l 4.0) 
        ) 
        (princ "請重選") 
        (command "erase" en3 en4 "") 
        (setq no (- no 1)) 
       ) 
     ) 
     (setq no (1+ no)) 
  )                                        ;end while 
 
  (setq pt1 (getpoint "\n請選擇面積列表插入點:")) 
  (setq i 0) 
  (setq sumarea 0.0) 
  (repeat (length lst) 
    (setq pt2 (polar pt1 (* 1.5 pi) (* (* 2.0 i) th))) 
    (command "text" 
             "j" 
             "bl" 
             pt2 
             th 
             "0" 
             (strcat "No" (rtos (1+ i) 2 0) ": " (nth i lst) "m2") 
    ) 
    (setq sumarea (+ sumarea (nth i area_lst))) 
    (setq i (1+ i)) 
  ) 
  (setq pt2 (polar pt1 (* 1.5 pi) (* (* 2.0 i) th))) 
  (command "text" 
           "j" 
           "bl" 
           pt2 
           th 
           "0" 
           (strcat "Σ area=" (rtos sumarea 2 d2) "m2") 
  ) 
 
  (setvar "dimzin" dimzin) 
  (setvar "osmode" os) 
  (princ) 
) 
 
;;;==========副程式pt&tudo，start=============== 
(defun pt&tudo (en / i nn pt) 
  (setq        endata (entget en) 
        pt_lst '() 
        gx_lst '() 
  ) 
  (setq i 0) 
  (repeat (length endata) 
    (setq nn (nth i endata)) 
    (cond ((= (car nn) 10) 
           (setq pt (cdr nn)) 
           (setq pt_lst (append pt_lst (list pt))) 
          ) 
          ((= (car nn) 42) 
           (setq gx (cdr nn)) 
           (setq gx_lst (append gx_lst (list gx))) 
          ) 
    ) 
    (setq i (1+ i)) 
  ) 
 
  (setq i 0) 
  (setq l (length pt_lst)) 
  (if (> l 3) 
    (progn 
      (repeat l 
        (cond ((< (+ i 2) l) 
               (setq x1 (car (nth i pt_lst))) 
               (setq y1 (cadr (nth i pt_lst))) 
               (setq x2 (car (nth (+ i 1) pt_lst))) 
               (setq y2 (cadr (nth (+ i 1) pt_lst))) 
               (setq x3 (car (nth (+ i 2) pt_lst))) 
               (setq y3 (cadr (nth (+ i 2) pt_lst))) 
               (setq 
                 xs 
                  (- (* (- y3 y1) (- x2 x1)) (* (- x3 x1) (- y2 y1))) 
               ) 
               (if 
                 (< (abs xs) 1e-6) 
                  (progn 
                    (setq pt_lst (vl-remove (nth (+ i 1) pt_lst) pt_lst)) 
                    (setq l (length pt_lst)) 
                    (setq i (- i 1)) 
                  ) 
               ) 
              ) 
              ((= (+ i 2) l) 
               (setq x1 (car (nth i pt_lst))) 
               (setq y1 (cadr (nth i pt_lst))) 
               (setq x2 (car (nth (+ i 1) pt_lst))) 
               (setq y2 (cadr (nth (+ i 1) pt_lst))) 
               (setq x3 (car (nth 0 pt_lst))) 
               (setq y3 (cadr (nth 0 pt_lst))) 
               (setq 
                 xs 
                  (- (* (- y3 y1) (- x2 x1)) (* (- x3 x1) (- y2 y1))) 
               ) 
               (if 
                 (< (abs xs) 1e-6) 
                  (progn 
                    (setq pt_lst (vl-remove (nth (+ i 1) pt_lst) pt_lst)) 
                    (setq l (length pt_lst)) 
                    (setq i (- i 1)) 
                  ) 
               ) 
              ) 
              ((= (+ i 1) l) 
               (setq x1 (car (nth i pt_lst))) 
               (setq y1 (cadr (nth i pt_lst))) 
               (setq x2 (car (nth 0 pt_lst))) 
               (setq y2 (cadr (nth 0 pt_lst))) 
               (setq x3 (car (nth 1 pt_lst))) 
               (setq y3 (cadr (nth 1 pt_lst))) 
               (setq 
                 xs 
                  (- (* (- y3 y1) (- x2 x1)) (* (- x3 x1) (- y2 y1))) 
               ) 
               (if 
                 (< (abs xs) 1e-6) 
                  (progn 
                    (setq pt_lst (vl-remove (nth 0 pt_lst) pt_lst)) 
                    (setq l (length pt_lst)) 
                    (setq i (- i 1)) 
                  ) 
               ) 
              ) 
        ) 
        (setq i (1+ i)) 
      ) 
    ) 
  ) 
) 
;;;==========副程式pt&tudo，end===============

huopojinshu · 发表于 2015-3-29 22:40:31

auva 发表于 2015-3-9 21:20

能把结果列式合并输出吗大神谢谢了

auva · 发表于 2015-3-31 21:10:42

aeo 发表于 2015-3-31 15:58
你这扇形公式对吗？

感谢版主的指正{:soso_e179:}

账号		自动登录	找回密码
密码			立即注册

[求助] 求大神写个算面积能列式的插件小弟谢谢了

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评