矩形面积及周长公式的输出

yamjqq · 发表于 2015-7-8 10:49:35

三种输出形式（公式输出顺序按照矩形点选的顺序，格式同示例）
1、<1>输出面积公式（不选默认<1>）
2、<2>输出长度公式
3、<3>同时输出面积和长度公式
图纸见附图

fan_zh · 发表于 2015-7-8 11:11:15

为什么非要输出公式？相同尺寸需要合并？给领导看？
如果把长宽数据导出excel清单，不是更直接？
这种程序论坛很多了

yamjqq · 发表于 2015-7-8 11:24:08

工程量标注在图上更直接，便于核对

fan_zh · 发表于 2015-7-8 11:49:43

附件效果是不是你要的？差个周长，改下比较简单

yamjqq · 发表于 2015-7-8 12:12:57

不用表的形式，用连加可以吗

fan_zh · 发表于 2015-7-8 13:35:12

但如果数据多，连加不是会长得很？

fan_zh · 发表于 2015-7-8 15:37:35

本帖最后由 fan_zh 于 2015-7-8 16:36 编辑

<blockquote>(defun c:tg ( / nr tot_area en1 i bclst pts el text1 text2 text3 m x1 bc_new x2 n a b c ii)

fan_zh · 发表于 2015-7-8 15:40:21

目前只输出面积公式，其余要求等有时间再完善吧

fan_zh · 发表于 2015-7-8 16:36:58

(defun c:tg ( / nr tot_area en1 i bclst pts el text1 text2 text3 m x1 bc_new x2 n a b c ii)
(vl-load-com)
(princ "\n请框选矩形:")
(setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4))))
(setq nr 0)
(setq tot_area 0)
(repeat (sslength ss)
(setq en1 (ssname ss nr))
(command "._area" "_O" en1)
(setq tot_area (+ tot_area (getvar "area")))
(setq nr (1+ nr))
)
(setq i 0 bclst nil pts nil)
(repeat (sslength ss)
(setq el (entget (ssname ss i)))
(setq pts nil)
(foreach pt el (if (= (car pt) 10) (setq pts (cons (cdr pt) pts))))
(setq bclst (cons (qab pts) bclst));;;;;qab 为考虑方向子程
(setq i (1+ i))
);repeat
(setq bc_new nil)
(while bclst
(setq m (car bclst)
x1 (length bclst))
(setq bclst (vl-remove m bclst))
(setq x2 (length bclst))
(setq n (- x1 x2))
(setq bc_new (cons (list m n) bc_new))
)
(setq ii 0 text1 nil text2 nil text3 nil)
(repeat (length bc_new)
(setq a (caar (nth ii bc_new)))
(setq b (cdar (nth ii bc_new)))
(setq c (cadr (nth ii bc_new)))
(setq text1 (strcat (rtos a 2 2) "*" (rtos b 2 2 ) "*" (rtos c 2 2)))
(if (< ii (- (length bc_new) 1))
(setq text1 (strcat text1 "+"))
)
(if (= ii 0)
(setq text2 text1)
(setq text2 (strcat text2 text1)))
(setq ii (1+ ii))
)
(setq text2 (strcat text2 "=" (rtos tot_area 2 2)))
;(cond ((= method1 "1")
(setq p2 (getpoint "\起始位置"))
(setq p3 (polar p2 0 3000))
(command "_.TEXT" "c" p2 "500" "0" text2)
(princ))
(defun qab (pts / a b);求边长，考虑方向
(if (equal (cadr (car pts)) (cadr (cadr pts)) 0.1)
(progn (setq a (distance (car pts) (cadr pts)))
(setq b (distance (cadr pts) (caddr pts))))
(progn (setq a (distance (cadr pts) (caddr pts)))
(setq b (distance (car pts) (cadr pts)))))
(cons (atof(rtos a 2 1)) (atof (rtos b 2 1)))
)
(defun qbc (pts / b h);求边长，不考虑方向
(setq b (distance (car pts) (cadddr pts)))
(setq h (distance (car pts) (cadr pts)))
(setq b (atof (rtos b 2 1)))
(setq h (atof (rtos h 2 1)))
(cons (max b h) (min b h))
);结束qbc

(defun c:tg ( / nr tot_area en1 i bclst pts el text1 text2 text3 m x1 bc_new x2 n a b c ii) 
(vl-load-com) 
  (princ "\n请框选矩形:") 
  (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4)))) 
  (setq nr 0) 
  (setq tot_area 0) 
  (repeat (sslength ss) 
    (setq en1 (ssname ss nr)) 
        (command "._area" "_O" en1) 
         (setq tot_area (+ tot_area (getvar "area"))) 
          (setq nr (1+ nr)) 
          ) 
  (setq i 0 bclst nil pts nil) 
        (repeat (sslength ss) 
         (setq el (entget (ssname ss i))) 
         (setq pts nil) 
         (foreach pt el (if (= (car pt) 10) (setq pts (cons (cdr pt) pts)))) 
             (setq bclst (cons (qab pts) bclst));;;;;qab 为考虑方向子程 
         (setq i (1+ i)) 
         );repeat 
(setq bc_new nil) 
(while bclst 
  (setq m (car bclst) 
      x1 (length bclst)) 
  (setq bclst (vl-remove m bclst)) 
  (setq x2 (length bclst)) 
  (setq n (- x1 x2)) 
  (setq bc_new (cons (list m n) bc_new)) 
) 
(setq ii 0 text1 nil text2 nil text3 nil)      
(repeat (length bc_new) 
    (setq a (caar (nth ii bc_new))) 
        (setq b (cdar (nth ii bc_new))) 
    (setq c (cadr (nth ii bc_new))) 
        (setq text1 (strcat (rtos a 2 2) "*" (rtos b 2 2 ) "*" (rtos c 2 2))) 
        (if (< ii (- (length bc_new) 1)) 
           (setq text1 (strcat text1 "+")) 
           ) 
        (if (= ii 0) 
           (setq text2  text1) 
           (setq text2 (strcat text2 text1))) 
           (setq ii (1+ ii)) 
        ) 
(setq text2 (strcat text2 "=" (rtos tot_area 2 2))) 
;(cond ((= method1 "1") 
     (setq p2 (getpoint "\起始位置")) 
     (setq p3 (polar p2 0 3000)) 
     (command "_.TEXT" "c" p2 "500" "0" text2) 
         (princ)) 
         (defun qab (pts / a b);求边长，考虑方向 
(if (equal (cadr (car pts)) (cadr (cadr pts)) 0.1) 
   (progn (setq a (distance (car pts) (cadr pts))) 
        (setq b (distance (cadr pts) (caddr pts)))) 
   (progn (setq a (distance (cadr pts) (caddr pts))) 
        (setq b (distance (car pts) (cadr pts))))) 
(cons (atof(rtos a 2 1)) (atof (rtos b 2 1))) 
) 
(defun qbc (pts / b h);求边长，不考虑方向 
(setq b (distance (car pts) (cadddr pts))) 
(setq h (distance (car pts) (cadr pts))) 
(setq b (atof (rtos b 2 1))) 
(setq h (atof (rtos h 2 1))) 
(cons (max b h) (min b h)) 
);结束qbc

cable2004 · 发表于 2015-7-8 16:45:53

(defun c:tt ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4)))) (progn
  (setq i -1 area nil len nil)
  (repeat (sslength ss)
(setq ent (entget(setq en (ssname ss (setq i (1+ i))))))
(setq lst (list))
(foreach x ent (if (= (car x) 10) (setq lst (cons (cdr x) lst))))
(setq en (vlax-ename->vla-object en))
(entmakex (list (cons 0 "TEXT")
                  (cons 10 (inters (car lst) (caddr lst) (cadr lst) (cadddr lst)))
                  (cons 1  (strcat "面积:"(rtos (vla-get-Area  en) 2 2)
      "----周长:"(rtos (vla-get-Length  en) 2 2)))
                  (cons 40 30))
   )
(setq area (cons (vla-get-Area  en) area)
   len  (cons (vla-get-Length  en) len))
  )
  (entmakex (list (cons 0 "TEXT")
                  (cons 10 (getpoint "面积总和插入点"))
                  (cons 1  (setq aaa (apply 'strcat  (append (list "总面积：")(cdr (apply 'append (mapcar '(lambda (x)  (list "+" (rtos x 2 2) )) area )))
         (list "=" (rtos (apply '+ area) 2 2))))))
                  (cons 40 30))
   )
  (entmakex (list (cons 0 "TEXT")
                  (cons 10 (getpoint "长度总和插入点"))
                  (cons 1  (setq aaa (apply 'strcat  (append (list "总长度：")(cdr (apply 'append (mapcar '(lambda (x)  (list "+" (rtos x 2 2) )) len )))
         (list "=" (rtos (apply '+ len) 2 2))))))
                  (cons 40 30))
   )
))
(setvar "CMDECHO" 1)
(princ)
)

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

[已解答] 矩形面积及周长公式的输出

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块