批量形心插块
本帖最后由 asd19400 于 2014-9-1 15:55 编辑批量形心插块：所求形心的图形一般为矩形，圆或者闭合多段线，不闭合的线段不用管。首先选择插入的块，插入点为块的基点，插入块的位置为图形的形心，支持批量形心插块 (defun c:xxck(/ en ent i obj pt ss s1 s2 s3)
(vl-load-com)
(setvar "cmdecho" 0)
(setq blk1 (cdr (assoc 2 (entget (car (entsel "\n选择要插入的块"))))))
(if (setq ss (ssget '((0 . "PLINE,LWPOLYLINE,LINE,ARC,CIRCLE,SPLINE,ELLIPSE"))))
(progn
(setq i -1)
(while (setq s1 (ssname ss (setq i (1+ i))))
(entmakex (entget s1))
(setq s2 (entlast))
(command ".region" s2 "")
(setq s3 (entlast))
(setq obj (vlax-ename->vla-object s3))
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj))))
(entmake (list '(0 . "INSERT") (cons 2 blk1) (cons 10 pt)))
(entdel s3)
)
)
(princ "\n没有选择对象.")
)
(princ)
)
修改了一下，有些不懂原先的程序做什么事情用的，我就删掉了 自己拼着写 ;;; 框选多个闭合图形画质心点 by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:zx(/ 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
(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 ss1 (ssadd ptls ss1))
)
)
)
(sssetfirst nil ss1)
)
(princ "\n没有选择对象.")
)
(princ)
)
批量找形心的 (entmake (list '(0 . "INSERT") (cons 2 "块名") (cons 10 pt)))
这句是插块的，替换掉画点的那行就可以了 lyqiezi 发表于 2014-9-25 00:24 static/image/common/back.gif
(entmake (list '(0 . "INSERT") (cons 2 "块名") (cons 10 pt)))
这句是插块的，替换掉画点的 ...
上面的程序会把闭合多段线打断，而且块名固定了，我想要的是效果是首先选择块，再选择闭合的多段线形心为插入点，纯菜鸟 不懂lisp lyqiezi 发表于 2014-9-28 11:19 static/image/common/back.gif
(defun c:xxck(/ en ent i obj pt ss s1 s2 s3)
(vl-load-com)
(setvar "cmdecho" 0)
测试了可以用，不过建议加一个出错的处理程序，排除不闭合的多段线，要不然程序会有错误信息，
; 错误: ActiveX 服务器返回错误: 未知名称: Centroid (defun c:xxck(/ en ent i obj pt ss s1 s2 s3)
(vl-load-com)
(setvar "cmdecho" 0)
(setq blk1 (cdr (assoc 2 (entget (car (entsel "\n选择要插入的块"))))))
(if (setq ss (ssget '((0 . "PLINE,LWPOLYLINE,CIRCLE,SPLINE,ELLIPSE"))))
(progn
(setq i -1)
(while (setq s1 (ssname ss (setq i (1+ i))))
(entmakex (entget s1))
(setq s2 (entlast))
(command ".region" s2 "")
(setq s3 (entlast))
(if (= "REGION" (cdr (assoc 0 (entget s3))))
(progn
(setq obj (vlax-ename->vla-object s3))
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj))))
(entmake (list '(0 . "INSERT") (cons 2 blk1) (cons 10 pt)))
(entdel s3)
)
(entdel s2)
)
)
)
(princ "\n没有选择对象.")
)
(princ)
) 可能当时删掉的就是容错代码，现在去掉了一些不应该选的line，arc等，增加容错，如果region不成功的话，就略过
但是还有个问题，就是region命令的反映没有屏蔽掉
看看是否原先代码存在屏蔽region反映的功能 (defun c:xxck(/ en ent i obj pt ss s1 s2)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "delobj" 0)
(setq blk1 (cdr (assoc 2 (entget (car (entsel "\n选择要插入的块"))))))
(if (setq ss (ssget '((0 . "PLINE,LWPOLYLINE,CIRCLE,SPLINE,ELLIPSE"))))
(progn
(setq i -1)
(while (setq s1 (ssname ss (setq i (1+ i))))
(command ".region" s1 "")
(setq s2 (entlast))
(if (= "REGION" (cdr (assoc 0 (entget s2))))
(progn
(setq obj (vlax-ename->vla-object s2))
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj))))
(entmake (list '(0 . "INSERT") (cons 2 blk1) (cons 10 pt)))
(entdel s2)
)
)
)
)
(princ "\n没有选择对象.")
)
(prin1)
)
还是不知道怎么解决region的提示
这次不再用entmakex复制，然后再删除的方法，而是使用delobj的系统参数，减少无谓的步骤
页:
[1]
2