关于块插入点在ucs=用户自定义和ucs=w时坐标点乱象问题

啵浪鼓

回复 highflybir 的帖子

还是没法解决，飞版出高招呀

highflybird

啵浪鼓 发表于 2011-7-31 19:54
回复 highflybir 的帖子

还是没法解决，飞版出高招呀

解决代码在此。

1. (vl-load-com)
   
2. (prompt "\n命令是:test")
   
3. ;;;取得块的正常插入点,如果这个块中有圆,弧,或者椭圆，则取其中心为插入点；
   
4. ;;;如果没有,则取这个块的包围盒为正常点，然后判断块的插入点。如果他们的位
   
5. ;;;置重合，则什么都不做；如果不重合，则用点标记。                        
   
6. (defun c:test (/ i lst sel ent dxf Name Cen mat pnt obj ret ll ur)               
   
7.   (setq i 0)
   
8.   (setq lst nil)
   
9.   (if (setq sel (ssget '((0 . "INSERT"))))                                ;选择块参照
   
10.     (repeat (sslength sel)
    
11.       (setq ent (ssname sel i))                                                ;块参照的图元名
    
12.       (setq dxf (entget ent))                                                ;块参照的实体数据
    
13.       (setq Name (cdr (assoc 2 dxf)))                                        ;块的名字
    
14.       (if (setq Cen (assoc Name lst))                                        ;是否求出中心点
    
15.         (setq Cen (cdr Cen))                                                 
    
16.         (setq Cen (GetCorrectInsertion Name)                                ;求中心点
    
17.               lst (cons (cons Name Cen) lst)
    
18.         )
    
19.       )
    
20.       (if Cen
    
21.         (setq mat (RefGeom ent)                                                ;中心点存在的话，求变换矩阵
    
22.               pnt (mapcar '+ (mxv (car mat) Cen) (cadr mat))                ;并把这点变换到WCS
    
23.         )
    
24.         (setq obj (vlax-ename->vla-object ent)
    
25.               ret (vla-GetBoundingBox obj 'll 'ur)                        ;不存在则求包围盒
    
26.               ll  (vlax-safearray->list ll)                                ;包围盒的左下点
    
27.               ur  (vlax-safearray->list ur)                                ;包围盒的右上点
    
28.               pnt (mapcar '/ (mapcar '+ ll ur) '(2 2 2))                ;这两点的中点为中心点
    
29.         )
    
30.       )
    
31.       (if (not (equal pnt (cdr (assoc 10 dxf)) 1e-6))                         ;容差可自定义
    
32.         (MarkIt pnt)                                                        ;中心点跟插入点不符合，标记位置
    
33.       )
    
34.       (setq i (1+ i))
    
35.     )
    
36.   )
    
37.   (princ)
    
38. )
    

(vl-load-com)<br /> (prompt "\n命令是:test")<br /> ;;;取得块的正常插入点,如果这个块中有圆,弧,或者椭圆，则取其中心为插入点；<br /> ;;;如果没有,则取这个块的包围盒为正常点，然后判断块的插入点。如果他们的位<br /> ;;;置重合，则什么都不做；如果不重合，则用点标记。                        <br /> (defun c:test (/ i lst sel ent dxf Name Cen mat pnt obj ret ll ur)                <br />   (setq i 0)<br />   (setq lst nil)<br />   (if (setq sel (ssget '((0 . "INSERT"))))                                ;选择块参照<br />     (repeat (sslength sel)<br />       (setq ent (ssname sel i))                                                ;块参照的图元名<br />       (setq dxf (entget ent))                                                ;块参照的实体数据<br />       (setq Name (cdr (assoc 2 dxf)))                                        ;块的名字<br />       (if (setq Cen (assoc Name lst))                                        ;是否求出中心点<br />         (setq Cen (cdr Cen))                                                 <br />         (setq Cen (GetCorrectInsertion Name)                                ;求中心点<br />               lst (cons (cons Name Cen) lst)<br />         )<br />       )<br />       (if Cen<br />         (setq mat (RefGeom ent)                                                ;中心点存在的话，求变换矩阵<br />               pnt (mapcar '+ (mxv (car mat) Cen) (cadr mat))                ;并把这点变换到WCS<br />         )<br />         (setq obj (vlax-ename->vla-object ent)<br />               ret (vla-GetBoundingBox obj 'll 'ur)                        ;不存在则求包围盒<br />               ll  (vlax-safearray->list ll)                                ;包围盒的左下点<br />               ur  (vlax-safearray->list ur)                                ;包围盒的右上点<br />               pnt (mapcar '/ (mapcar '+ ll ur) '(2 2 2))                ;这两点的中点为中心点<br />         )<br />       )<br />       (if (not (equal pnt (cdr (assoc 10 dxf)) 1e-6))                         ;容差可自定义<br />         (MarkIt pnt)                                                        ;中心点跟插入点不符合，标记位置<br />       )<br />       (setq i (1+ i))<br />     )<br />   )<br />   (princ)<br /> )<br />

啵浪鼓

回复 highflybird 的帖子

高飞版主的几何运算真利害，解决了我困扰已久的难题，膜拜！

非常感谢！

10410024

w

yan19851204

cash1331

你们怎么这么复杂。。。我用一个命令就使插入点正确，是不是碰巧，，，，

(defun C:234 ()      
(prompt "\n 顶针过孔")   
     (command "ucs" "")    ;一定要设定UCS，要不然坐标跑了。。
    (setq pt (getpoint "请选择顶针位置:\n"))
下面是正常程序。。。。。。

cash1331

不好意思，我可能是没理解意思。。
我的程序是任选点的时候，插入的块随点。。    没试过出WCS坐标点是否一致。。希望不要误导别人。。。

liu_kunlun

是否是想知道插入块的真正世界坐标？如果是，可以这样解决：
1）从10组得到插入点的OCS坐标:(setq pt (cdr (assoc 10 (entget ent))))
2）将此坐标转换到WCS坐标:(trans pt ent 0)
ent:insert实体

第2）句如用(trans pt ent 1)可得到插入点的当前UCS坐标

highflybir

楼上两位真的不要误导别人。
先搞清楚了楼主的意图和一些函数的用法。
注意一点： （trans pt ent 0) 的用法：如果ent 的法向矢量跟'(0 0 1)相等，这样相当不执行转化。

shalei021647

唉，同遇到过这种问题