回复 highflybir 的帖子
还是没法解决，飞版出高招呀
本帖最后由 highflybird 于 2011-8-1 18:24 编辑
啵浪鼓 发表于 2011-7-31 19:54 static/image/common/back.gif
回复 highflybir 的帖子
还是没法解决，飞版出高招呀
解决代码在此。
(vl-load-com)
(prompt "\n命令是:test")
;;;取得块的正常插入点,如果这个块中有圆,弧,或者椭圆，则取其中心为插入点；
;;;如果没有,则取这个块的包围盒为正常点，然后判断块的插入点。如果他们的位
;;;置重合，则什么都不做；如果不重合，则用点标记。
(defun c:test (/ i lst sel ent dxf Name Cen mat pnt obj ret ll ur)
(setq i 0)
(setq lst nil)
(if (setq sel (ssget '((0 . "INSERT")))) ;选择块参照
(repeat (sslength sel)
(setq ent (ssname sel i)) ;块参照的图元名
(setq dxf (entget ent)) ;块参照的实体数据
(setq Name (cdr (assoc 2 dxf))) ;块的名字
(if (setq Cen (assoc Name lst)) ;是否求出中心点
(setq Cen (cdr Cen))
(setq Cen (GetCorrectInsertion Name) ;求中心点
lst (cons (cons Name Cen) lst)
)
)
(if Cen
(setq mat (RefGeom ent) ;中心点存在的话，求变换矩阵
pnt (mapcar '+ (mxv (car mat) Cen) (cadr mat)) ;并把这点变换到WCS
)
(setq obj (vlax-ename->vla-object ent)
ret (vla-GetBoundingBox obj 'll 'ur) ;不存在则求包围盒
ll(vlax-safearray->list ll) ;包围盒的左下点
ur(vlax-safearray->list ur) ;包围盒的右上点
pnt (mapcar '/ (mapcar '+ ll ur) '(2 2 2)) ;这两点的中点为中心点
)
)
(if (not (equal pnt (cdr (assoc 10 dxf)) 1e-6)) ;容差可自定义
(MarkIt pnt) ;中心点跟插入点不符合，标记位置
)
(setq i (1+ i))
)
)
(princ)
)
回复 highflybird 的帖子
高飞版主的几何运算真利害，解决了我困扰已久的难题，膜拜！
非常感谢！
w
你们怎么这么复杂。。。我用一个命令就使插入点正确，是不是碰巧，，，，
(defun C:234 ()
(prompt "\n 顶针过孔")
(command "ucs" "") ;一定要设定UCS，要不然坐标跑了。。
(setq pt (getpoint "请选择顶针位置:\n"))
下面是正常程序。。。。。。
不好意思，我可能是没理解意思。。
我的程序是任选点的时候，插入的块随点。。 没试过出WCS坐标点是否一致。。希望不要误导别人。。。
本帖最后由 liu_kunlun 于 2011-10-28 17:03 编辑
是否是想知道插入块的真正世界坐标？如果是，可以这样解决：
1）从10组得到插入点的OCS坐标:(setq pt (cdr (assoc 10 (entget ent))))
2）将此坐标转换到WCS坐标:(trans pt ent 0)
ent:insert实体
第2）句如用(trans pt ent 1)可得到插入点的当前UCS坐标
楼上两位真的不要误导别人。
先搞清楚了楼主的意图和一些函数的用法。
注意一点： （trans pt ent 0) 的用法：如果ent 的法向矢量跟'(0 0 1)相等，这样相当不执行转化。
唉，同遇到过这种问题