[讨论]：如何判断点选的位置

walong · 发表于 2004-2-15 19:57:57

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

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

×

通过点选，可选中矩形，同时还要判断出点选的位置是处于矩形的什么位置（如：左边）。
矩形可能是用 line 、pliner 、 ectang 三种情况画出的，line画的矩形就不管了。

tuger · 发表于 2004-2-15 20:03:48

求出矩形的型心，根据选择点和型心的关系(x和y的坐标值)不就知道了吗

walong · 发表于 2004-2-15 21:07:16

;;获取图元的各个结点的坐标,适用于PLINE和rectang（BOX）
(defun c:tools1 ()
(vl-load-com)
(setq nlist nil)
(princ "获取图元的各个结点的坐标，命令：tools1")
(setq en (entsel "\n选择线: "))
(setq pt0 (osnap (cadr en) "nea")) ;按追踪方式设点，
;;(setq obj (car (entsel "\nSelect a Polyline: ")))
(setq obj (car en))
(if (= obj nil)
(princ "\n没有选中图元")
(MASSOC 10 (entget obj))
)
(pd)
(prin1)
)
(defun massoc (key alist /)
(setq iii 0)
(foreach x alist
(if (eq key (car x))
(progn (setq iii (1+ iii))
(setq nlist (cons (cdr x) nlist))
) ;end if
)
)
)
(defun pd ()
(setq ii 0)
(while (< ii iii)
(if (< (car (nth ii nlist)) (car pt0))
(progn (princ "在右边") (setq ii (+ iii 1)))
)
(if (> (car (nth ii nlist)) (car pt0))
(progn (princ "在左边") (setq ii (+ iii 1)))
)
(setq ii (1+ ii))
)
)

;;获取图元的各个结点的坐标,适用于PLINE和rectang（BOX） 
(defun c:tools1        ()                        
  (vl-load-com) 
  (setq nlist nil) 
  (princ "获取图元的各个结点的坐标，命令：tools1") 
  (setq en (entsel "\n选择线: ")) 
  (setq pt0 (osnap (cadr en) "nea"))        ;按追踪方式设点， 
 ;;(setq obj (car (entsel "\nSelect a Polyline: "))) 
  (setq obj (car en)) 
  (if (= obj nil) 
    (princ "\n没有选中图元") 
    (MASSOC 10 (entget obj)) 
  ) 
  (pd) 
  (prin1) 
) 
(defun massoc (key alist /) 
  (setq iii 0) 
  (foreach x alist 
    (if        (eq key (car x)) 
      (progn (setq iii (1+ iii)) 
             (setq nlist (cons (cdr x) nlist)) 
      )                                        ;end if 
    ) 
  ) 
) 
(defun pd () 
  (setq ii 0) 
  (while (< ii iii) 
    (if        (< (car (nth ii nlist)) (car pt0)) 
      (progn (princ "在右边") (setq ii (+ iii 1))) 
    ) 
    (if        (> (car (nth ii nlist)) (car pt0)) 
      (progn (princ "在左边") (setq ii (+ iii 1))) 
    ) 
    (setq ii (1+ ii)) 
  ) 
)

我是这么写的，感觉不够好，请大家完善！

再看这段代码，用质心来判断，但命令行中列出一大串参数，如果这样作程序就显得太难看了。

(defun c:ss ()
(setvar "cmdecho" 0)
(setq en (entsel "\n选择线: "))
(setq pt0 (osnap (cadr en) "nea"));按追踪方式设点，
(Command "massprop" en "" "y" "c:\\00")
(SetQ cpfn (Open "c:\\00.mpr" "r"))
(Repeat 7 (Read-Line cpfn))
(SetQ cpfx (Last (Read (StrCat "(" (Read-Line cpfn) ")")))
;提取质量中心X位置
cpfy (Last (Read (StrCat "(" (Read-Line cpfn) ")")))
;提取质量中心Y位置
)
(Close cpfn)
(if (< cpfx (car pt0))(progn (princ "在右边")(setq ii (+ iii 1))))
(if (> cpfx (car pt0))(progn (princ "在左边")(setq ii (+ iii 1))))
)

eachy · 发表于 2004-2-16 06:42:01

1 左右是相对的，你选择的时候在屏幕上看不见吗？！如果程序仅仅提示个左右编程的意义在什么地方？

2 对程序而言，图示矩形的情况是最简单的，还要考虑UCS情况，矩形绘制的起点情况，Pline中的组码 10 是OCS。

陌生人 · 发表于 2004-2-16 13:00:51

我也觉得旋，这种方法不是一种有效的方法

walong · 发表于 2004-2-16 19:58:08

“如果程序仅仅提示个左右编程的意义在什么地方？”
这只是为了方便测试。

我只作平面图，UCS基本上不用考虑。
我用质心，只是决得不方便。

陌生人 · 发表于 2004-2-16 22:15:10

用massprop要先做成region，solid。
如果不考虑ucs，为什么不用实体包围盒?

(defun x_boxcen (eobj )
(if (= 'ENAME (type eobj)) (setq eobj (vlax-ename->vla-object eobj)))
(vla-GetBoundingBox eobj 'minpt 'maxpt)
(setq pt1 (vlax-safearray->list minpt)
pt3 (vlax-safearray->list maxpt))
(mapcar '(lambda (x y) (/ (+ x y) 2))(list pt1 pt3)) ;求包围盒中心
)
(defun c:test ()
(setq el (entsel "\n选择实体边:"))
(if (< (car (cadr el)) (car (x_boxcen (car el)))
(princ "\n在左边.")
(princ "\n在右边.")
)
)

lsjjm · 发表于 2004-3-4 11:09:45

最初由陌生人发布
[B]用massprop要先做成region，solid。
如果不考虑ucs，为什么不用实体包围盒?... [/B]

这个程序有错!

陌生人 · 发表于 2004-3-4 12:37:46

sorry，修正如下：
[php]
(defun x_boxcen ( eobj )
 (if (= 'ENAME (type eobj)) (setq eobj (vlax-ename->vla-object eobj)))
 (vla-GetBoundingBox eobj 'minpt 'maxpt)
 (setq pt1 (vlax-safearray->list minpt)
 pt3 (vlax-safearray->list maxpt))
(mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt3) ;求包围盒中心
)
(defun c:test ()
(setq el (entsel "\n选择实体边:"))
(if (< (car (cadr el)) (car (x_boxcen (car el))))
(princ "\n在左边.")
(princ "\n在右边.")
)(princ)
)

[/php]

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

[讨论]：如何判断点选的位置

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

相关帖子