- 积分
- 639
- 明经币
- 个
- 注册时间
- 2016-9-30
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 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)
)
|
|