【炫翔】函数是否还有优化的空间

炫翔 · 发表于 2013-9-12 10:19:11

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

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

×

;功能:指定图元最小外接矩形的九点坐标 9点
;;;(xx-9pt 实体名参数)
;上:7 8 9 中:4 5 6 下:1 2 3
;;;参数＝1～9，上中下9位码；其他均为左下角点
;7 8 9
;4 5 6
;1 2 3
;(xx-9pt (CAR(ENTSEL)) 5)
(defun xx-9pt (s1 mode / dx dy pt maxp minp x1 x2 y1 y2)
(setq s1 (vlax-ename->vla-object s1))
(vla-getboundingbox s1 'minpoint 'maxpoint)
(setq maxp (vlax-safearray->list maxpoint);取得第9点
minp (vlax-safearray->list minpoint);取得第1点
x1 (car minp)
x2 (car maxp)
y1 (cadr minp)
y2 (cadr maxp)
dx (* (- x2 x1) 0.5)
dy (* (- y2 y1) 0.5)
)
(cond ((= mode 1) (setq pt minp))
((= mode 2) (setq pt (list (+ x1 dx) y1 0.0)))
((= mode 3) (setq pt (list x2 y1 0.0)))
((= mode 4) (setq pt (list x1 (+ y1 dy)0.0)))
((= mode 5) (setq pt (list (+ x1 dx) (+ y1 dy)0.0)))
((= mode 6) (setq pt (list x2 (+ y1 dy)0.0)))
((= mode 7) (setq pt (list x1 y2 0.0)))
((= mode 8) (setq pt (list (+ x1 dx) y2 0.0)))
((= mode 9) (setq pt maxp))
(t (setq pt minp))
)
pt
)

;功能:指定图元最小外接矩形的九点坐标 9点 
;;;(xx-9pt 实体名 参数) 
;上:7 8 9 中:4 5 6  下:1 2 3 
;;;参数＝1～9，上中下9位码；其他均为左下角点 
;7 8 9 
;4 5 6 
;1 2 3 
;(xx-9pt (CAR(ENTSEL)) 5) 
(defun xx-9pt (s1 mode / dx dy pt maxp minp x1 x2 y1 y2) 
   (setq s1 (vlax-ename->vla-object s1)) 
   (vla-getboundingbox s1 'minpoint 'maxpoint) 
   (setq maxp (vlax-safearray->list maxpoint);取得第9点 
         minp (vlax-safearray->list minpoint);取得第1点 
              x1  (car minp) 
              x2  (car maxp) 
              y1  (cadr minp) 
              y2  (cadr maxp) 
              dx  (* (- x2 x1) 0.5) 
              dy  (* (- y2 y1) 0.5) 
   ) 
   (cond ((= mode 1) (setq pt minp)) 
         ((= mode 2) (setq pt (list (+ x1 dx) y1 0.0))) 
         ((= mode 3) (setq pt (list x2 y1 0.0))) 
         ((= mode 4) (setq pt (list x1 (+ y1 dy)0.0))) 
         ((= mode 5) (setq pt (list (+ x1 dx) (+ y1 dy)0.0))) 
         ((= mode 6) (setq pt (list x2 (+ y1 dy)0.0))) 
         ((= mode 7) (setq pt (list x1 y2 0.0))) 
         ((= mode 8) (setq pt (list (+ x1 dx) y2 0.0))) 
         ((= mode 9) (setq pt maxp)) 
         (t (setq pt minp)) 
   ) 
   pt 
)

newer · 发表于 2013-9-12 10:35:39

是程序就有继续完善的空间，

炫版，试试你的函数对裁剪块，MTEXT，UCS下，图形有转角，是否都能正确求出准确的9点坐标？

zxq0220 · 发表于 2013-9-12 10:55:07

;功能:指定图元最小外接矩形的九点坐标 9点
;;;(xx-9pt 实体名参数)
;上:7 8 9 中:4 5 6 下:1 2 3
;;;参数＝1～9，上中下9位码；其他均为左下角点
;7 8 9
;4 5 6
;1 2 3
;(xx-9pt (CAR(ENTSEL)) 5)
(defun xx-9pt (s1 mode / dx dy pt maxp minp x1 x2 y1 y2)
(setq s1 (vlax-ename->vla-object s1))
(vla-getboundingbox s1 'minpoint 'maxpoint)
(setq maxp (vlax-safearray->list maxpoint);取得第9点
minp (vlax-safearray->list minpoint);取得第1点
x1 (car minp)
x2 (car maxp)
y1 (cadr minp)
y2 (cadr maxp)
dx (* (- x2 x1) 0.5)
dy (* (- y2 y1) 0.5)
)
(cond
((= mode 1) minp)
((= mode 2) (list (+ x1 dx) y1 0.0))
((= mode 3) (list x2 y1 0.0))
((= mode 4) (list x1 (+ y1 dy) 0.0))
((= mode 5) (list (+ x1 dx) (+ y1 dy)0.0))
((= mode 6) (list x2 (+ y1 dy)0.0))
((= mode 7) (list x1 y2 0.0))
((= mode 8) (list (+ x1 dx) y2 0.0))
((= mode 9) maxp)
(t minp)
)
)

;功能:指定图元最小外接矩形的九点坐标 9点 
;;;(xx-9pt 实体名 参数) 
;上:7 8 9 中:4 5 6  下:1 2 3 
;;;参数＝1～9，上中下9位码；其他均为左下角点 
;7 8 9 
;4 5 6 
;1 2 3 
;(xx-9pt (CAR(ENTSEL)) 5) 
(defun xx-9pt (s1 mode / dx dy pt maxp minp x1 x2 y1 y2) 
 (setq s1 (vlax-ename->vla-object s1)) 
 (vla-getboundingbox s1 'minpoint 'maxpoint) 
 (setq maxp (vlax-safearray->list maxpoint);取得第9点 
       minp (vlax-safearray->list minpoint);取得第1点 
       x1  (car minp) 
       x2  (car maxp) 
       y1  (cadr minp) 
       y2  (cadr maxp) 
       dx  (* (- x2 x1) 0.5) 
       dy  (* (- y2 y1) 0.5) 
 ) 
 (cond 
  ((= mode 1) minp) 
  ((= mode 2) (list (+ x1 dx) y1 0.0)) 
  ((= mode 3) (list x2 y1 0.0)) 
  ((= mode 4) (list x1 (+ y1 dy) 0.0)) 
  ((= mode 5) (list (+ x1 dx) (+ y1 dy)0.0)) 
  ((= mode 6) (list x2 (+ y1 dy)0.0)) 
  ((= mode 7) (list x1 y2 0.0)) 
  ((= mode 8) (list (+ x1 dx) y2 0.0)) 
  ((= mode 9) maxp) 
  (t minp) 
 ) 
)

炫翔 · 发表于 2013-9-12 11:06:52

另一种方法<不过速度好像还慢些，供参考

(defun xx-9pt (s1 mode / np xd xp xyd yd)
(setq s1 (vlax-ename->vla-object s1))
(vla-getboundingbox s1 'minpoint 'maxpoint)
(setq xp (vlax-safearray->list maxpoint);取得第9点
np (vlax-safearray->list minpoint);取得第1点
)
(setq xyd(mapcar (function (lambda (a b c) (abs (- a b)))) xp np '(0 0)));(xd yd)
(setq xd(car xyd) yd(cadr xyd))
(cond ((= mode 1) np)
((= mode 2) (polar np (* pi 2) (* xd 0.5)))
((= mode 3) (polar np (* pi 2) xd))
((= mode 4) (polar np (* pi 0.5) (* yd 0.5)))
((= mode 5) (list (+ (car np) (* xd 0.5)) (+ (cadr np) (* yd 0.5))0.0))
((= mode 6) (polar xp (* 1.5 pi) (* yd 0.5)))
((= mode 7) (polar np (* pi 0.5) yd))
((= mode 8) (polar xp 0 (* xd 0.5)))
((= mode 9) xp)
(t np)
)
)

newer · 发表于 2013-9-12 11:09:52

本帖最后由 newer 于 2013-9-12 11:13 编辑

zxq0220 发表于 2013-9-12 10:55

MAXXP好像不是第9点吧，应该是第5点吧？

newer · 发表于 2013-9-12 11:16:59

继续讨论前，应该首先定义下你的9点是什么位置？定义的不一样，肯定就不同了。

我的定义是逆时针方向 0-7，加一个最后的中心点9，你呢？

炫翔 · 发表于 2013-9-12 11:18:52

newer 发表于 2013-9-12 11:16
继续讨论前，应该首先定义下你的9点是什么位置？定义的不一样，肯定就不同了。

我的定义是逆时针方向 ...

789456
123

分别是9点位置，5在中心，1在左下点，9在右上点

zhangq_cai1 · 发表于 2013-9-12 11:24:46

院长的9点坐标~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~···

(defun xyp-9Pt (ename site / MinPT MaxPT p1 p9 p5 p3 p7 p2 p4 p6 p8)
(defun mid (p1 p2)(mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2)))
(setq ename (cond ((= (type ename) 'ENAME) (vlax-ename->vla-object ename))
((= (type ename) 'VLA-OBJECT) ename)
)
)
(vla-getboundingbox ename 'MinPT 'MaxPT)
(setq p1 (vlax-safearray->list MinPT)
p9 (vlax-safearray->list MaxPT)
p5 (mid p1 p9)
p3 (if (< (car p9) (car p1))
(list (car p1) (cadr p9) (caddr p1))
(list (car p9) (cadr p1) (caddr p1))
)
p7 (if (< (car p9) (car p1))
(list (car p9) (cadr p1) (caddr p9))
(list (car p1) (cadr p9) (caddr p9))
)
p2 (mid p1 p3)
p4 (mid p1 p7)
p6 (mid p3 p9)
p8 (mid p7 p9)
)
(nth (- site 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))
)

(defun xyp-9Pt (ename site / MinPT MaxPT p1 p9 p5 p3 p7 p2 p4 p6 p8) 
  (defun mid (p1 p2)(mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2))) 
  (setq ename (cond ((= (type ename) 'ENAME) (vlax-ename->vla-object ename)) 
             ((= (type ename) 'VLA-OBJECT) ename) 
              ) 
  ) 
  (vla-getboundingbox ename 'MinPT 'MaxPT) 
  (setq p1 (vlax-safearray->list MinPT) 
        p9 (vlax-safearray->list MaxPT) 
        p5 (mid p1 p9) 
        p3 (if (< (car p9) (car p1)) 
             (list (car p1) (cadr p9) (caddr p1)) 
             (list (car p9) (cadr p1) (caddr p1)) 
           ) 
        p7 (if (< (car p9) (car p1)) 
             (list (car p9) (cadr p1) (caddr p9)) 
             (list (car p1) (cadr p9) (caddr p9)) 
           ) 
        p2 (mid p1 p3) 
        p4 (mid p1 p7) 
        p6 (mid p3 p9) 
        p8 (mid p7 p9) 
  ) 
  (nth (- site 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9)) 
)

炫翔 · 发表于 2013-9-12 11:29:18

zhangq_cai1 发表于 2013-9-12 11:24
院长的9点坐标~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~···

院长的测试时间;目前最慢

(defun get-utime()(* 86400.0 (getvar"tdusrtimer")))
(defun c:xx (/ i s1 ss t1 t2)
(setq ss (ssget '((0 . "text")))
i -1
)
(setq t1 (get-utime))
(while (setq s1 (ssname ss (setq i (1+ i))))
(xyp-9Pt s1 5)
)
(setq t2 (get-utime))
(PRINC (list 0 0 (- t2 t1)))
(princ)
)
;时间:9.172

newer · 发表于 2013-9-12 11:33:08

炫翔发表于 2013-9-12 11:29
院长的测试时间;目前最慢

讨论帖子嘛，把具体运行时间贴出来吧，大家上下看着好比较，不能让大家回去自己运行啊。

/db_自贡黄明儒_ · 发表于 2013-9-12 11:34:37

newer 发表于 2013-9-12 10:35
是程序就有继续完善的空间，

炫版，试试你的函数对裁剪块，MTEXT，UCS下，图形有转角，是否都能正确求 ...

newer版主，你考虑了裁剪块，MTEXT，UCS下，图形有转角等情况，更通用了，能否贴出来我们学习一下？

炫翔 · 发表于 2013-9-12 11:40:52

;7 8 9
;4 5 6
;1 2 3
(defun xx-9pt (s1 mode / np p6 xd xp yd)
(setq s1 (vlax-ename->vla-object s1))
(vla-getboundingbox s1 'minpoint 'maxpoint)
(setq xp (vlax-safearray->list maxpoint);取得第9点
np (vlax-safearray->list minpoint);取得第1点
)
(setq p6(list(car xp)(cadr np) 0.0))
(setq xd(distance np p6) yd(distance xp p6))
(cond ((= mode 1) np)
((= mode 2) (polar np (* pi 2) (* xd 0.5)))
((= mode 3) p6)
((= mode 4) (polar np (* pi 0.5) (* yd 0.5)))
((= mode 5) (list (+ (car np) (* xd 0.5)) (+ (cadr np) (* yd 0.5))0.0))
((= mode 6) (polar xp (* 1.5 pi) (* yd 0.5)))
((= mode 7) (polar np (* pi 0.5) yd))
((= mode 8) (polar xp 0 (* xd 0.5)))
((= mode 9) xp)
(t np)
)
)
;下面是测试程序（1560 个文字）
;7.343秒;炫翔旧
;7.844秒;院长
;7.328秒;炫翔新
(defun get-utime()(* 86400.0 (getvar"tdusrtimer")))
(defun c:xx (/ i s1 ss t1 t2)
(setq ss (ssget '((0 . "text")))
i -1
)
(setq t1 (get-utime))
(while (setq s1 (ssname ss (setq i (1+ i))))
(mapcar '(lambda (x) (xx-9pt s1 x)) '(1 2 3 4 5 6 7 8 9))
)
(setq t2 (get-utime))
(PRINC (list 0 0 (- t2 t1)))
(princ)
)

;7 8 9 
;4 5 6 
;1 2 3 
(defun xx-9pt (s1 mode / np p6 xd xp yd) 
   (setq s1 (vlax-ename->vla-object s1)) 
   (vla-getboundingbox s1 'minpoint 'maxpoint) 
   (setq xp (vlax-safearray->list maxpoint);取得第9点 
         np (vlax-safearray->list minpoint);取得第1点 
   ) 
   (setq p6(list(car xp)(cadr np) 0.0)) 
   (setq xd(distance np p6) yd(distance xp p6)) 
   (cond ((= mode 1) np) 
         ((= mode 2) (polar np (* pi 2) (* xd 0.5))) 
         ((= mode 3) p6) 
         ((= mode 4) (polar np (* pi 0.5) (* yd 0.5))) 
         ((= mode 5) (list (+ (car np) (* xd 0.5)) (+ (cadr np) (* yd 0.5))0.0)) 
         ((= mode 6) (polar xp (* 1.5 pi) (* yd 0.5))) 
         ((= mode 7) (polar np (* pi 0.5) yd)) 
         ((= mode 8) (polar xp 0 (* xd 0.5))) 
         ((= mode 9) xp) 
         (t np) 
   ) 
) 
;下面是测试程序（1560 个文字） 
;7.343秒;炫翔旧 
;7.844秒;院长 
;7.328秒;炫翔新 
(defun get-utime()(* 86400.0 (getvar"tdusrtimer"))) 
(defun c:xx (/ i s1 ss t1 t2) 
  (setq ss (ssget '((0 . "text"))) 
        i -1 
  ) 
  (setq t1 (get-utime)) 
  (while (setq s1 (ssname ss (setq i (1+ i)))) 
   (mapcar '(lambda (x) (xx-9pt s1 x)) '(1 2 3 4 5 6 7 8 9)) 
  ) 
  (setq t2 (get-utime)) 
  (PRINC (list 0 0 (- t2 t1))) 
  (princ) 
)

newer · 发表于 2013-9-12 11:46:09

炫翔发表于 2013-9-12 11:29
院长的测试时间;目前最慢

具体到这个问题是，不能以大作借口啊，你的函数的参数是实体名， mtext 块这些的，你不准备做参数吗？如果把mtext 实体做参数放你这个函数里面，你不是一样要计算吗？可你计算的结果不对啊。

不能让用户再去做个函数去处理MTEXT啊。

函数就是个黑盒子，你能做的都放里面，用户用着就舒心了。

newer · 发表于 2013-9-12 11:49:45

/db_自贡黄明儒_ 发表于 2013-9-12 11:34
newer版主，你考虑了裁剪块，MTEXT，UCS下，图形有转角等情况，更通用了，能否贴出来我们学习一下？

现成的，函数发布里面都有

;|
获得实体或选集的9个特征点
参数：
e --- 实体或选择集
返回值：
点表
说明：特征点，左下第一点，然后逆时针，中心点最后
基于当前UCS平行的包围盒
|;
(defun XD::Geom:9pt (e / box)
(setq box (XD::Entity:BOX e))
(XD::Geom:BOX->9PT box)
)
;|
获得实体或选择集9点中的指定点
参数：
e --- 实体或选择集
index--指定索引（0-8）
返回值：
点
|;
(defun XD::Geom:Get9PT(e index / box)
(setq box (XD::Geom:9pt e))
(nth index e)
)
;|
包围盒4点得到9点坐标
参数：
box --- 点表（4个）
返回值：
点表（9点）
|;
(defun XD::Geom:BOX->9PT (box / p0 p1 p2 p3 p4 p5 p6 p7 p8)
(setq p0 (nth 0 box)
p2 (nth 1 box)
p1 (xdrx_midp p0 p2)
p4 (nth 2 box)
p3 (xdrx_midp p2 p4)
p6 (nth 3 box)
p5 (xdrx_midp p4 p6)
p7 (xdrx_midp p0 p6)
p8 (xdrx_midp p0 p4)
)
(list p0 p1 p2 p3 p4 p5 p6 p7 p8)
)

;| 
获得实体或选集的9个特征点 
参数： 
   e --- 实体或选择集 
返回值： 
   点表 
说明：特征点，左下第一点，然后逆时针，中心点最后 
基于当前UCS平行的包围盒 
|; 
(defun XD::Geom:9pt (e / box) 
   (setq box (XD::Entity:BOX e)) 
   (XD::Geom:BOX->9PT box) 
) 
;| 
获得实体或选择集9点中的指定点 
参数： 
   e --- 实体或选择集 
   index--指定索引（0-8） 
返回值： 
   点 
|; 
(defun XD::Geom:Get9PT(e index / box) 
   (setq box (XD::Geom:9pt e)) 
   (nth index e) 
)          
 
 
;| 
包围盒4点得到9点坐标 
参数： 
  box --- 点表（4个） 
 
返回值： 
 
  点表（9点） 
|; 
(defun XD::Geom:BOX->9PT (box / p0 p1 p2 p3 p4 p5 p6 p7 p8) 
  (setq p0 (nth 0 box) 
        p2 (nth 1 box) 
        p1 (xdrx_midp p0 p2) 
        p4 (nth 2 box) 
        p3 (xdrx_midp p2 p4) 
        p6 (nth 3 box) 
        p5 (xdrx_midp p4 p6) 
        p7 (xdrx_midp p0 p6) 
        p8 (xdrx_midp p0 p4) 
  ) 
  (list p0 p1 p2 p3 p4 p5 p6 p7 p8) 
)

/db_自贡黄明儒_ · 发表于 2013-9-12 12:01:22

现在电脑速度越来越快，所以我认为考虑通用是必要的。但你这个看不出对裁剪块，MTEXT，UCS是如何处理的。

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

[研讨] 【炫翔】函数是否还有优化的空间

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

相关帖子

点评

点评

评分

点评

点评

点评

点评

评分

点评

点评

评分

点评

点评

点评