[求助]：能否一选中一个矩形便得到四个角点坐标？

carrot1983 · 发表于 2006-12-14 21:28:08

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

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

×

矩形的四个角点都是(10 .数值)
请问有没有办法把四个角点的数值依次求得。。。。
一般只能取得一个角点。。如下：

(setq ss (ssget))
(setq na (ssname ss 0))
(setq data (entget na))
(setq faq (cdr (assoc '10 data)))

扩展开来。就是有没有办法求出如果有多个
(code value)中的code相同的时不同的value值。

kohi · 发表于 2006-12-15 03:32:15

[php]
(defun c:test ()
(setq rec (car (entsel "pick rectangle:")))
(acet-geom-vertex-list rec)
)
[/php]

taner · 发表于 2006-12-15 08:06:43

[FONT=courier new]
;;; ==================================================================
;;; 求多義線所有頂點.返回所有頂點表.(晓东上收集的，好象是XYP大师和狂刀写的）
;;; ==================================================================
(defun th1-get-allvertexs (ename / plist pp n)
(setq obj (vlax-ename->vla-object ename))
(setq plist (vlax-safearray->list (vlax-variant-value
(vla-get-coordinates obj)
)
)
)
(setq n 0)
(repeat (/ (length plist) 2)
(setq pp (append
pp
(list (list (nth n plist) (nth (1+ n) plist)))
)
)
(setq n (+ n 2))
)
pp
)
;;; 二维点表
(defun th2-get-allvertexs (e / n lst)
(repeat (setq n (fix (1+ (vlax-curve-getendparam e))))
(setq lst (cons (vlax-curve-getpointatparam e (setq n (1- n))) lst))
)
)
;;; 三维点表
[/FONT]

[FONT=courier new] 
;;; ================================================================== 
;;; 求多義線所有頂點.返回所有頂點表.(晓东上收集的，好象是XYP大师和狂刀写的） 
;;; ================================================================== 
(defun th1-get-allvertexs (ename / plist pp n) 
  (setq obj (vlax-ename->vla-object ename)) 
  (setq plist (vlax-safearray->list (vlax-variant-value 
                                                        (vla-get-coordinates obj) 
                                    ) 
              ) 
  ) 
  (setq n 0) 
  (repeat (/ (length plist) 2) 
    (setq pp (append 
               pp 
               (list (list (nth n plist) (nth (1+ n) plist))) 
             ) 
    ) 
    (setq n (+ n 2)) 
  ) 
  pp 
) 
;;; 二维点表 
(defun th2-get-allvertexs (e / n lst) 
  (repeat (setq n (fix (1+ (vlax-curve-getendparam e)))) 
    (setq lst (cons (vlax-curve-getpointatparam e (setq n (1- n))) lst)) 
  ) 
) 
;;; 三维点表 
  [/FONT]

highflybird · 发表于 2006-12-15 12:59:13

[php]
(defun C:test (/ ss ename elist ptlist)
  (setq ss (entsel "\n请选取多段线(或样条曲线): "))
  (setq ename (car ss))
  (setq elist (entget ename))
  (foreach n elist
(if (= 10 (car n))
   (setq ptlist (cons (cdr n) ptlist))
)
  )
  (reverse ptlist)
)
[/php]

我给出一段代码，能返回多段线（或者样条曲线）端点列表，也很简单，无须acet函数，无须vlisp函数，适合各种CAD版本。

carrot1983 · 发表于 2006-12-15 18:18:30

首先，先谢谢楼上的所有人。。。谢谢。。。
4楼的真的很不错。。因为我现在只会用R14能用的lisp。我想应该可以从ptlist一个点一个点取出来吧。。。。。是什么函数啊？？好像有。。呵，当然2和3楼的高手向你们学习。

;求矩形的四个角点坐标
(defun c:test ()
(setq txtss (ssget))
(setq txts (ssname txtss 0))
(setq txtdate (entget txts))
(setq tP1 (CDR (assoc '10 txtdate)))
(setq txtdate (subst (cons 99 '(1000 1000)) (assoc '10 txtdate) txtdate))
(setq tP2 (CDR (assoc '10 txtdate)))
(setq txtdate (subst (cons 99 '(1000 1000)) (assoc '10 txtdate) txtdate))
(setq tP3 (CDR (assoc '10 txtdate)))
(setq txtdate (subst (cons 99 '(1000 1000)) (assoc '10 txtdate) txtdate))
(setq tP4 (CDR (assoc '10 txtdate)))
(prin1)
)

本程序的精华在下面这句：
(setq txtdate (subst (cons 99 '(1000 1000)) (assoc '10 txtdate) txtdate))
呵呵。很有意思的一句。我还不知道不同的code可以替换。我们一般是code相同时来替换
不同的value。。。这是今天刚问公司的学长的。

taner · 发表于 2006-12-15 21:29:51

最初由 highflybird 发布
[B][php]
(defun C:test (/ ss ename elist ptlist)
  (setq ss (entsel "\n请选取多段线(或样条曲线): "))
  (setq ename (car ss))
  (setq elist (entget ename))
  (foreach n elist
(if (= 10 (car n))
... [/B]

[FONT=courier new]
;改一下，变为一个通用函数
(defun test (ename / n ptlist)
(foreach n (entget ename)
(if (= 10 (car n))
(setq ptlist (cons (cdr n) ptlist))
)
)
(reverse ptlist)
)
;;;这样改一下，应用更广。
(defun th2-massoc (key alist / x nlist)
(foreach x alist
(if (eq key (car x))
(setq nlist (cons (cdr x) nlist))
)
)
(reverse nlist)
);;;用于点对第一项相同的子项的第二项的集合
(defun th4-get-allvertexs (ename )
(th2-massoc 10 (entget ename))
);;;求顶点坐标集合
[/FONT]

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

[求助] [求助]：能否一选中一个矩形便得到四个角点坐标？

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

相关帖子