所有明经币求 求大神写个智能重心lisp，必谢-
本帖最后由 wchsunshine 于 2022-3-12 22:02 编辑GIF效果，是其他软件的 ，它是输入命令后选择先一个图像为主，再根据命令栏提示选项:1、增加面积 2、减少面积（可多个图形），输入1或2 ，再手动选择面积，进行布尔运算，得到运算后的图形的质心。坐等大神解决！！！！！！！ 不需要弹出的XY坐标对话框，只要有点标记就OK了！
本帖最后由 htlaser 于 2022-3-7 18:36 编辑
wchsunshine 发表于 2022-3-7 12:56
我可不需要批量，也可不需要智能，这个求质心功能在CAXA中有，分几步完成就可以，它是输入命令后选择先一 ...
图形需处理闭合线条命令<ZHX>
ZNZX默认=>1 单个(图1 图2功能)
=>2 并集(图4 功能 直接框选 (曲线布尔的并集功能))
=>3 差集(图3 功能 先选最大外框-->空格再选内轮廓(曲线布尔的差集功能))
坐等大神帮忙解决
22#
发表于 2016-10-13 16:36 | 只看该作者
;;; 对大师作品做了一些修改，框选多个闭合图形画质心点 by:langjs;;;
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:XX (/ en ent i obj pt ptls snap ss ss1)
(setvar "cmdecho" 0) ; 关闭命令行显示
(if (setq ss (ssget '((0 . "PLINE,LWPOLYLINE,LINE,ARC,CIRCLE,SPLINE,ELLIPSE"))))
(progn
(setq snap (getvar "osmode"))
(setvar "osmode" 0)
(setq en (entlast))
(command ".region" ss ""); 对选择集做面域
(if en
(progn
(setq ss (ssadd))
(while (setq en (entnext en))
(ssadd en ss)
)
(if (zerop (sslength ss))
(setq ss nil)
)
)
(setq ss (ssget "_x"))
)
(setq ss1 (ssadd))
(repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i))))
(if (= (cdr (assoc 0 (entget ent))) "REGION"); 如果成功生成面域
(progn
(vl-load-com)
(setq obj (vlax-ename->vla-object ent))
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj)))); 取得质心坐标
(command ".point" pt); 画质心点
(setq ptls (entlast))
(command ".explode" ent); 分解面域
(setq NS (ssget "p"))
(command "Peditaccept" "0" ""); 打开多段线合并询问提示
(command "pedit" "m" NS "" "y" "j" "" ""); 合并
(setq ss1 (ssadd ptls ss1))
)
)
)
(sssetfirst nil ss1); 夹点亮显质心点
(setvar "osmode" snap)
)
(princ "\n没有选择对象.")
)
(setvar "cmdecho" 1) ; 开启命令行显示
(princ)
) http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91845&page=1&_dsign=31ffa960
http://bbs.mjtd.com/thread-92028-1-1.html?_dsign=21fb1f07
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=180024&highlight=CAD%D7%D4%B6%AF%C9%FA%B3%C9%C3%E6%D3%F2%B5%C4%D6%CA%D0%C4&_dsign=8ca21bfb 本帖最后由 wchsunshine 于 2022-3-6 12:56 编辑
xj6019 发表于 2022-3-4 22:08
22#
发表于 2016-10-13 16:36 | 只看该作者
;;; 对大师作品做了一些修改，框选多个闭合图形画质心点...
图一 图二可以实现 ，图三、图四实现不了，能不能优化下，或针对第二种重新写个lisp， 增加面积 或减少面积功能 实现多个图形的质心，用面域加减， 请大师帮忙。 本帖最后由 wchsunshine 于 2022-3-6 12:30 编辑
xj6019 发表于 2022-3-4 22:10
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91845&page=1&_dsign=31ffa960
http://bbs.mjtd.com/t ...
这里的帖子图三、图四实现不了，能不能优化下改下程序，或针对第二种重新写个lisp，请大师帮忙 本帖最后由 wchsunshine 于 2022-3-6 12:54 编辑
xj6019 发表于 2022-3-4 22:08
22#
发表于 2016-10-13 16:36 | 只看该作者
;;; 对大师作品做了一些修改，框选多个闭合图形画质心点...
如果能再实现 增加面积 或减少面积功能 实现多个图形的质心，如图三图四就好了 坐等大师帮忙解决 本帖最后由 tigcat 于 2022-3-6 21:51 编辑
;仅交流,不知道改的谁的了;注意事项1:程序不能用于直线(直线求形心俺不会)
;注意事项2:程序求形心未考虑多段线的面积(可补充函数获取面积来修正)
(defun c:tt5 (/ ss i x0 y0 ptnum e)
;;;(setvar "cmdecho" 0)
(setq ss(ssget
'((0 . "PLINE,LWPOLYLINE,LINE,ARC,CIRCLE,SPLINE,ELLIPSE"))
)
i -1
x00
y00
num (sslength ss)
)
(while (setq e (ssname ss (setq i (1+ i))))
(setq pt (centroid e)
x0 (+ x0 (car pt))
y0 (+ y0 (cadr pt))
)
(command "point" pt)
)
(command "point" "non"
(list (/ x0 num) (/ y0 num))
)
(princ)
)
;; 闭合曲线质心子函数by_xyp
(defun Centroid (s1 / s2 pt)
(vl-load-com)
(command "copy" s1 "" '(0 0) '(0 0))
(command "region" (entlast) "")
(setq s2 (entlast)
pt (vlax-get (vlax-ename->vla-object s2) 'Centroid)
)
(entdel s2)
pt
;;;(princ)
)
页:
[1]
2