戏男 发表于 2015-7-28 14:54:22

好复杂 看得我头晕了

GILES.LEI 发表于 2016-10-13 16:36:21

;;; 对大师作品做了一些修改，框选多个闭合图形画质心点 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)
)

luojie110 发表于 2017-12-27 12:09:41

正好需要啊非常感谢

m809289064j 发表于 2017-12-30 19:50:18

没搞定

半夜星星 发表于 2018-3-16 21:28:34

如果是两个分开的H型钢（2个独立的封闭H形，但是中间是有空隙的）只能画右侧的质心，不知道如何可以画联合的质心呢，还有算其他的一些参数呢

梨子·桃 发表于 2024-2-23 09:35:27

GILES.LEI 发表于 2016-10-13 16:36
;;; 对大师作品做了一些修改，框选多个闭合图形画质心点 by:langjs;;;
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝ ...

大佬，能不能把生成的点改为十字中心线:loveliness:
页: 1 2 [3]
查看完整版本: 如何自动生成不规则多边形的质心