[LISP程序]：怎样提取坐标

redapple · 发表于 2003-6-8 21:55:45

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

例如一张图纸中有很多实体，怎样才能提取出所有实体中最边界的实体的坐标呢？比如左上角的坐标等

XDSoft · 发表于 2003-6-8 21:57:00

最初由 redapple 发布
[B]例如一张图纸中有很多实体，怎样才能提取出所有实体中最边界的实体的坐标呢？比如左上角的坐标等 [/B]

你说的是包围实体的最小矩形框的左上角坐标吗?

redapple · 发表于 2003-6-8 21:58:17

是所有实体当中最左上角的

XDSoft · 发表于 2003-6-8 22:01:16

最初由 redapple 发布
[B]是所有实体当中最左上角的 [/B]

不是所有的实体你都可以得到特征点坐标的.比如一个圆, 哪个是圆上的左上角呢?

通用的,只有是包围实体的最小外框.

你举个具体的实体例子, 然后说说你想要得到什么?

redapple · 发表于 2003-6-8 22:03:14

我是想在一张图纸中提取外墙的一点的坐标

XDSoft · 发表于 2003-6-8 22:07:53

最初由 redapple 发布
[B]我是想在一张图纸中提取外墙的一点的坐标 [/B]

ACAD里面没有墙实体, 每个人可能用不同的方法画墙, 请你说明下你的墙具体的实体是什么, 截图贴到论坛来, 说明下你要做什么, 大家才好讨论.

eachy · 发表于 2003-6-8 23:32:06

最初由 redapple 发布
[B]是所有实体当中最左上角的 [/B]

CAD中的实体有多种(Line、Arc、Spline、Circle、Ellpise、Dimension、Polyline、Ray等），假如是天正5等的还有自定义实体，所以你说的所有就不好确定了，也许找不到，也许找到了也不符合要求。

redapple · 发表于 2003-6-9 16:05:54

首先判断的前提是非建筑软件绘图，无论是何种实体，我需要的是整个图纸幅面上四个角上的实体，如果有特征点的话，提取特征点最好。问题有些抽象，不知有没有讲明白？

eachy · 发表于 2003-6-9 19:14:08

最初由 redapple 发布
[B]首先判断的前提是非建筑软件绘图，无论是何种实体，我需要的是整个图纸幅面上四个角上的实体，如果有特征点的话，提取特征点最好。问题有些抽象，不知有没有讲明白？ [/B]

建筑图纸中如果不进行处理，一般的最外围就是图框。

XDSoft · 发表于 2003-6-9 19:30:37

最初由 redapple 发布
[B]首先判断的前提是非建筑软件绘图，无论是何种实体，我需要的是整个图纸幅面上四个角上的实体，如果有特征点的话，提取特征点最好。问题有些抽象，不知有没有讲明白？ [/B]

下面是用 XDRX_API 实现的

[font=courier]
(if (setq ss (ssget))
(progn
(setq box (xdrx_entity_box ss))
)
)
[/font]

上面的BOX变量保存了你选择的实体的最大外框的四个角点.

redapple · 发表于 2003-6-9 19:32:14

图框里面除了标注之外的实体

eachy · 发表于 2003-6-9 20:37:46

来个Vlisp的

(defun SSMAP (func ss / n)
(if (eq 'PICKSET (type ss))
(repeat (setq n (fix (sslength ss))) ; fixed
(apply func (list (ssname ss (setq n (1- n)))))
)
)
)
;;求单独图元或选择集的包围盒
(defun ea:getssboundingbox (ss / ax:GetBoundingBox
plist xplst yplst xmax
ymax xmin ymin pt
)
;;;返回一个单独图元的范围
(defun ax:GetBoundingBox (ent / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
(cond
((eq (type ss) 'PICKSET)
(progn
(ssmap
(function
(lambda (ent)
(setq plist (cons (ax:getBoundingBox ent) plist))
)
)
ss
)
(setq plist (apply 'append plist))
(setq xplst (mapcar 'car plist)
yplst (mapcar 'cadr plist)
)
(setq xmax (apply 'max xplst)
ymax (apply 'max yplst)
xmin (apply 'min xplst)
ymin (apply 'min yplst)
)
)
)
((eq (type ss) 'ENAME)
(setq pt (ax:GetBoundingBox ss))
(setq xmax (caadr pt)
ymax (cadadr pt)
xmin (caar pt)
ymin (cadar pt)
)
)
(T)
)
(list (trans (list xmin ymin) 0 1)
(trans (list xmax ymin) 0 1)
(trans (list xmax ymax) 0 1)
(trans (list xmin ymax) 0 1)
)
)

(defun SSMAP (func ss / n) 
  (if (eq 'PICKSET (type ss)) 
    (repeat (setq n (fix (sslength ss))) ; fixed 
      (apply func (list (ssname ss (setq n (1- n))))) 
    ) 
  ) 
) 
;;求单独图元或选择集的包围盒 
(defun ea:getssboundingbox (ss              /                ax:GetBoundingBox 
                            plist     xplst        yplst          xmax 
                            ymax      xmin        ymin          pt 
                           ) 
;;;返回一个单独图元的范围 
  (defun ax:GetBoundingBox (ent / ll ur) 
    (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur) 
    (mapcar 'vlax-safearray->list (list ll ur)) 
  ) 
  (cond 
    ((eq (type ss) 'PICKSET) 
     (progn 
       (ssmap 
         (function 
           (lambda (ent) 
             (setq plist (cons (ax:getBoundingBox ent) plist)) 
           ) 
         ) 
         ss 
       ) 
       (setq plist (apply 'append plist)) 
       (setq xplst (mapcar 'car plist) 
             yplst (mapcar 'cadr plist) 
       ) 
       (setq xmax (apply 'max xplst) 
             ymax (apply 'max yplst) 
             xmin (apply 'min xplst) 
             ymin (apply 'min yplst) 
       ) 
     ) 
    ) 
    ((eq (type ss) 'ENAME) 
     (setq pt (ax:GetBoundingBox ss)) 
     (setq xmax        (caadr pt) 
           ymax        (cadadr pt) 
           xmin        (caar pt) 
           ymin        (cadar pt) 
     ) 
    ) 
    (T) 
  ) 
  (list        (trans (list xmin ymin) 0 1) 
        (trans (list xmax ymin) 0 1) 
        (trans (list xmax ymax) 0 1) 
        (trans (list xmin ymax) 0 1) 
  ) 
)

nihao2002 · 发表于 2005-4-23 16:05:58

如何批量提取图中圆弧中心点的xyz坐标到文本本件中

qiaqiadeng · 发表于 2006-7-3 13:55:11

研究一下吧：
(defun boundingbox (obj minp maxp)
  (vl-load-com)
  (vla-getboundingbox
(vlax-ename->vla-object obj)
'minp
'maxp
  )
  (setq minp (vlax-safearray->list minp)
maxp (vlax-safearray->list maxp)
  )
)

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：怎样提取坐标

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [LISP程序]：怎样提取坐标