所有明经币求 求大神写个智能重心lisp，必谢-

wchsunshine

GIF效果，是其他软件的 ，它是输入命令后选择先一个图像为主，再根据命令栏提示选项:1、增加面积 2、减少面积（可多个图形），输入1或2 ，再手动选择面积，进行布尔运算，得到运算后的图形的质心。  坐等大神解决！！！！！！！ 不需要弹出的XY坐标对话框，只要有点标记就OK了！

htlaser

wchsunshine 发表于 2022-3-7 12:56
我可不需要批量，也可不需要智能，这个求质心功能在CAXA中有，分几步完成就可以，它是输入命令后选择先一 ...

图形需处理闭合线条命令<ZHX>
ZNZX默认  =>1 单个  (图1 图2功能)

=>2 并集  (图4 功能 直接框选 (曲线布尔的并集功能))
=>3 差集  (图3 功能 先选最大外框-->空格  再选内轮廓  (曲线布尔的差集功能))

wchsunshine

坐等大神帮忙解决

xj6019

       
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)
)

xj6019

http://bbs.mjtd.com/forum.php?mo ... amp;_dsign=31ffa960
http://bbs.mjtd.com/thread-92028-1-1.html?_dsign=21fb1f07
http://bbs.mjtd.com/forum.php?mo ... amp;_dsign=8ca21bfb

wchsunshine

xj6019 发表于 2022-3-4 22:08
22#
发表于 2016-10-13 16:36 | 只看该作者
;;; 对大师作品做了一些修改，框选多个闭合图形画质心点  ...

图一   图二可以实现   ，图三、图四实现不了  ，能不能优化下，或针对第二种重新写个lisp， 增加面积 或减少面积功能 实现多个图形的质心，用面域加减， 请大师帮忙。

wchsunshine

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

xj6019 发表于 2022-3-4 22:08
22#
发表于 2016-10-13 16:36 | 只看该作者
;;; 对大师作品做了一些修改，框选多个闭合图形画质心点  ...

如果能再实现 增加面积 或减少面积功能 实现多个图形的质心，如图三图四就好了   

wchsunshine

坐等大师帮忙解决

tigcat

1. ;仅交流,不知道改的谁的了;注意事项1:程序不能用于直线(直线求形心俺不会)
   
2. ;注意事项2:程序求形心未考虑多段线的面积(可补充函数获取面积来修正)
   
3. (defun c:tt5 (/ ss i x0 y0 pt  num e)
   
4. 
   
5. ;;;  (setvar "cmdecho" 0)
   
6.   (setq        ss  (ssget
   
7.               '((0 . "PLINE,LWPOLYLINE,LINE,ARC,CIRCLE,SPLINE,ELLIPSE"))
   
8.             )
   
9.         i   -1
   
10.         x0  0
    
11.         y0  0
    
12.         num (sslength ss)
    
13.   )
    
14.   (while (setq e (ssname ss (setq i (1+ i))))
    
15.     (setq pt (centroid e)
    
16.           x0 (+ x0 (car pt))
    
17.           y0 (+ y0 (cadr pt))
    
18.     )
    
19.     (command "point" pt)
    
20.   )
    
21.   (command "point" "non"
    
22.            (list (/ x0 num) (/ y0 num))
    
23.   )
    
24.   (princ)
    
25. )
    
26. ;; 闭合曲线质心子函数by_xyp
    
27. (defun Centroid        (s1 / s2 pt)
    
28.   (vl-load-com)
    
29.   (command "copy" s1 "" '(0 0) '(0 0))
    
30.   (command "region" (entlast) "")
    
31.   (setq        s2 (entlast)
    
32.         pt (vlax-get (vlax-ename->vla-object s2) 'Centroid)
    
33.   )
    
34.   (entdel s2)
    
35.   pt
    
36. ;;;  (princ)
    
37. )
    

;仅交流,不知道改的谁的了;注意事项1:程序不能用于直线(直线求形心俺不会)<br /> ;注意事项2:程序求形心未考虑多段线的面积(可补充函数获取面积来修正)<br /> (defun c:tt5 (/ ss i x0 y0 pt  num e)<br /> <br /> ;;;  (setvar "cmdecho" 0)<br />   (setq        ss  (ssget<br />               '((0 . "PLINE,LWPOLYLINE,LINE,ARC,CIRCLE,SPLINE,ELLIPSE"))<br />             )<br />         i   -1<br />         x0  0<br />         y0  0<br />         num (sslength ss)<br />   )<br />   (while (setq e (ssname ss (setq i (1+ i))))<br />     (setq pt (centroid e)<br />           x0 (+ x0 (car pt))<br />           y0 (+ y0 (cadr pt))<br />     )<br />     (command "point" pt)<br />   )<br />   (command "point" "non"<br />            (list (/ x0 num) (/ y0 num))<br />   )<br />   (princ)<br /> )<br /> ;; 闭合曲线质心子函数by_xyp<br /> (defun Centroid        (s1 / s2 pt)<br />   (vl-load-com)<br />   (command "copy" s1 "" '(0 0) '(0 0))<br />   (command "region" (entlast) "")<br />   (setq        s2 (entlast)<br />         pt (vlax-get (vlax-ename->vla-object s2) 'Centroid)<br />   )<br />   (entdel s2)<br />   pt<br /> ;;;  (princ)<br /> )<br />