iCAx开思网

标题: 求大牛帮忙写个lisp程序 [打印本页]

作者: fothy 时间: 2006-10-17 14:35
标题: 求大牛帮忙写个lisp程序
有若干不规则闭合图形
有一条基准线(Y轴方向)
计算:
每个不规则图形长度*每个不规则图形的质心到基准线的水平距离(X方向)
以上除以所有不规则图形总周长
(质心:假设该图形有一定厚度,密度均匀)

求得以上的商数

谢谢大牛帮忙写个lisp程序

作者: qomolangma 时间: 2006-10-17 15:30
标题: 看看我的程序
;;; 2D object center
(defun c:peridiv()
(setq ss (ssget))
(setq i 0 total-peri 0.0 result 0.0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq vlaobj (vlax-ename->vla-object ent))
(setq perimeter (vlax-get-property vlaobj 'Perimeter))
(setq centroid (vlax-get-property vlaobj 'Centroid))
(if (and (/= perimeter nil) (/= centroid nil))
(progn
(setq item (* perimeter (car (vlax-safearray->list (vlax-variant-value centroid)))))
(setq total-peri (+ total-peri perimeter))
(setq result (+ result item))
)
)
(setq i (+ i 1))
)
(alert (strcat "The Result is : " (rtos (/ result total-peri) 2 4)))
(setq ss nil)
)

作者: qomolangma 时间: 2006-10-17 15:32
标题: 说明
在运行之前请将封闭的多边形组成面域(region).

作者: fothy 时间: 2006-10-17 21:01
请问这个lisp具体怎么操作
已经转换为面域
已经加载lisp程序 peridiv
已经选择所有图形

接下去就没了

作者: qomolangma 时间: 2006-10-18 14:10
1：先将要计算的各个封闭多边形组成面域。
2：加载程序，之后在命令行中输入命令。
3：选择计算的对象，完成之后回车。
4：若正常完成后将显示出一个对话框，之中就是结果了。

作者: fothy 时间: 2006-10-20 19:05
出现错误

no function definition: VLAX-ENAME->VLA-OBJECT

作者: qomolangma 时间: 2006-10-20 19:55
以上程序我是在AutoCAD2007中调试通过的，可能是你的系统版本问题。

作者: qomolangma 时间: 2006-10-20 19:58
;;; 2D object center
(defun c:peridiv()
(vl-load-com)
      (setq ss (ssget))
      (setq i 0 total-peri 0.0 result 0.0)
      (while (< i (sslength ss))
            (setq ent (ssname ss i))
            (setq vlaobj (vlax-ename->vla-object ent))
            (setq perimeter (vlax-get-property vlaobj 'Perimeter))
            (setq centroid (vlax-get-property vlaobj 'Centroid))
            (if (and (/= perimeter nil) (/= centroid nil))
                     (progn
                              (setq item (* perimeter (car (vlax-safearray->list (vlax-variant-value centroid)))))
                              (setq total-peri (+ total-peri perimeter))
                              (setq result (+ result item))
                              )
                     )
            (setq i (+ i 1))
            )
      (alert (strcat "The Result is : " (rtos (/ result total-peri) 2 4)))
      (setq ss nil)
      )

欢迎光临 iCAx开思网 (https://www.icax.net/)