kkdolphin 发表于 2019-12-22 00:00:13

完善面积计算两个功能.

;;这个面积统计程序不错，本人做了一定修改，奈何lsp有多年不用了。大神能否帮忙完善一下：1，输入z能切换到，所选的每个面积能自动取整到0.01m2，然后每个面积再相加，求出总面积；2，在选择类型统计时候，输入数字4，阳台面积会计算一半再取整，然后每个阳台再相加，生成的公式也要是一半取整的数字相加。程序如下，请修改：
(defun c:mj ( / &k1 &kw1 a1 a2 ss1 )
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-dump-object) (vl-load-com) );加载vlax函数
(princ "\n请选择要计算面积的对象")
(if (setq &kw1 (ssget '((0 . "POLYLINE,LWPOLYLINE,CIRCLE,ELLIPSE,SPLINE,REGION"))))
(progn
   (setq ss1 '() a1 0.0)
   (while (setq &k1 (ssname &kw1 0))
    (setq &kw1 (ssdel &k1 &kw1))
    (if (and
            (setq &k1 (vlax-ename->vla-object &k1));转换为vlax对象
            (null (vl-catch-all-error-p (setq a2 (vl-catch-all-apply 'vla-get-area (list &k1)))))
         );计算面积
   (progn
      (setq a1 (+ a1 a2));总面积
      (setq a2 (rtos a2))
      (if (car ss1)
       (setq ss1 (append ss1 (list "+" a2)));计算公式
       (setq ss1 (cons a2 ss1))
      )
   )
    )
   )
(setq A (getint "\n请输入一个整数(1.非分摊）（5.分摊）（4.阳台（没有半算））（6.墙体）:"))

(if (= A 1)(progn(command "TEXT" (setq p1 (getpoint)) (getdist p1 "\n输入文字高度") 0 (strcat "非分摊面积:" (rtos a1) "㎡"))))
(if (= A 5)(progn(command "TEXT" (setq p1 (getpoint)) (getdist p1 "\n输入文字高度") 0 (strcat "分摊面积:" (rtos a1) "㎡"))))
(if (= A 4)(progn(command "TEXT" (setq p1 (getpoint)) (getdist p1 "\n输入文字高度") 0 (strcat "阳台（没有半算）:" (rtos a1) "㎡"))))
(if (= A 6)(progn(command "TEXT" (setq p1 (getpoint)) (getdist p1 "\n输入文字高度") 0 (strcat "墙体面积:" (rtos a1) "㎡"))))
(princ "\n计算公式为:")
   (princ (apply 'strcat ss1));显示计算公式
)
)
(princ)
)

kkdolphin 发表于 2019-12-22 00:01:10

希望大神能帮一下忙！

kkdolphin 发表于 2019-12-22 20:43:36

哪位大神有空解决一下。

kkdolphin 发表于 2019-12-24 11:56:55

已经解决了。

kkdolphin 发表于 2019-12-26 22:32:13

(defun c:jmj ()
(setq 总面积 0)(setq 总亩数 0)(setq 面积 0)(setq 总周长 0)(setq 周长 0)(setq k 0)
(setq a nil)
(setq a (ssget))
(setq Len (sslength a))
(repeat Len
(setq name (ssname a k))
(setq ent1 (entget name))
(setq na (assoc 0 ent1))
(setq na (cdr na))
(if        (= na "SPLINE")
(progn
(command "area" "o" name)(setq 面积 (rtos (getvar "area") 2 2))(setq 面积 (distof 面积))(setq 总面积 (+ 总面积 面积))(setq 周长 (getvar "perimeter"))(setq 总周长 (+ 总周长 周长))
)
)
(if        (= na "POLYLINE")
(progn
(command "area" "o" name)
(setq 面积 (rtos (getvar "area") 2 2))(setq 面积 (distof 面积))(setq 总面积 (+ 总面积 面积))(setq 周长 (getvar "perimeter"))(setq 总周长 (+ 总周长 周长))
)
)
(if        (= na "ARC")
(progn(command "area" "o" name)(setq 面积 (rtos (getvar "area") 2 2))(setq 面积 (distof 面积))(setq 总面积 (+ 总面积 面积))(setq 周长 (getvar "perimeter"))(setq 总周长 (+ 总周长 周长))
)
)
。。。。。。
参考了人家的程序，修改了，还把周长也计算进去了。
页: [1]
查看完整版本: 完善面积计算两个功能.