找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

楼主: 炫翔

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

[复制链接]

已领礼包: 40个

财富等级: 招财进宝

发表于 2013-9-12 12:09:35 | 显示全部楼层
/db_自贡黄明儒_ 发表于 2013-9-12 12:01
现在电脑速度越来越快,所以我认为考虑通用是必要的。但你这个看不出对裁剪块,MTEXT,UCS是如何处理的。

一个函数一个函数往上面找。不能在最终的应用函数,还要把那些基础的代码都写到一起啊。

UCS的,看 XD::Entity:BOX
mtext,clipblock的,API直接就提供了 xdrx_entity_box ,你可以拿这个函数,去试试MTEXT,CLIPBLOCK。

点评

谢谢newer版主!!!  发表于 2013-9-12 12:43
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-9-12 13:18:08 | 显示全部楼层
newer 发表于 2013-9-12 11:16
继续讨论前 ,应该首先定义下你的9点是什么位置? 定义的不一样,肯定就不同了。

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

9点的位置顺序定义,最好要和MTEXT 附着点的顺序一致:
71
附着点:
1 = 左上;2 = 中上;3 = 右上
4 = 左中;5 = 正中;6 = 右中
7 = 左下;8 = 中下;9 = 右下
这样取得位置点后方便后续编程利用!

点评

MTEXT和TABLE实体都是有个生成方向属性 FlowDirection 的,默认是从上到下的。也可以设置从下到上的,这样第一个点就是左下点了。 大多数实体的方向都是左下点开始的,这样也符合习惯。  详情 回复 发表于 2013-9-12 15:03
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

发表于 2013-9-12 13:57:12 | 显示全部楼层
本帖最后由 /db_自贡黄明儒_ 于 2013-9-12 16:31 编辑

  1. ;;考虑UCS,照搬highflybird的程序
  2. ;|
  3. 1 = 左上;2 = 中上;3 = 右上
  4. 4 = 左中;5 = 正中;6 = 右中
  5. 7 = 左下;8 = 中下;9 = 右下
  6. |;
  7. (defun xx-9pt (ename / MATLST  MATRIX  NP      OBJ     ORIGIN
  8.                P6      REVMAT  UCSFLAG WCSORG  XD      XDIR    XP      YD
  9.                YDIR    ZDIR
  10.               )
  11.   ;;矩阵的变换与逆变换
  12.   (defun GetMatrix (lst org Revflag / I J MAT)
  13.     (setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3)))
  14.     ;;初始化一个4X4的矩阵
  15.     (setq i 0)
  16.     (repeat 3
  17.       (vlax-safearray-put-element mat i 3 (nth i org)) ;平移变换
  18.       (setq j 0)
  19.       (repeat 3
  20.         (if RevFlag
  21.           (vlax-safearray-put-element mat i j (nth j (nth i lst))) ;角度逆变换
  22.           (vlax-safearray-put-element mat i j (nth i (nth j lst))) ;角度的变换
  23.         )
  24.         (setq j (1+ j))
  25.       )
  26.       (setq i (1+ i))
  27.     )
  28.     (vlax-safearray-put-element mat 3 3 1)
  29.     mat                                                  ;返回矩阵
  30.   )
  31.   ;;两矢量的叉积
  32.   (defun G:CrossProductor (vec1 vec2 / a b c d e f)
  33.     (setq a (car vec1))
  34.     (setq b (cadr vec1))
  35.     (setq c (caddr vec1))
  36.     (setq d (car vec2))
  37.     (setq e (cadr vec2))
  38.     (setq f (caddr vec2))
  39.     (list
  40.       (- (* b f) (* c e))
  41.       (- (* c d) (* a f))
  42.       (- (* a e) (* b d))
  43.     )
  44.   )


  45.   (setq        obj (cond ((= (type ename) 'ENAME) (vlax-ename->vla-object ename))
  46.                   ((= (type ename) 'VLA-OBJECT) ename)
  47.             )
  48.   )
  49.   ;;先判断UCS是否与WCS相同。如是则取得UCS的X方向,
  50.   ;;Y方向,Z方向,UCS原点及WCS的原点相对UCS的坐标点
  51.   ;;然后得到UCS变换矩阵和到WCS的逆变换矩阵
  52.   (setq UcsFlag (getvar "WORLDUCS"))
  53.   (if (= UcsFlag 0)                                  ;UCS是否与WCS相同
  54.     (setq UcsFlag T                                  ;设置标志位为true
  55.           xdir          (getvar "UCSXDIR")                  ;X方向矢量
  56.           ydir          (getvar "UCSYDIR")                  ;Y方向矢量
  57.           zdir          (G:CrossProductor xdir ydir)          ;X和Y的方向矢量的叉积
  58.           origin  (getvar "UCSORG")                  ;原点
  59.           WcsOrg  (trans '(0 0 0) 0 1)                  ;WCS的原点相对UCS的坐标
  60.           matLst  (list xdir ydir zdir)                  ;旋转的变换矩阵表
  61.           matrix  (GetMatrix matLst origin nil)          ;从WCS到UCS的变换矩阵
  62.           revMat  (GetMatrix matLst WcsOrg T)          ;从UCS到WCS的变换矩阵
  63.     )
  64.     (setq UcsFlag nil)                                  ;否则不予变换
  65.   )
  66.   ;;在UCS下先变换物体到WCS下,取得每个物体的包围框,
  67.   ;;求出包围框集合的最小XY,最大XY,并用矩形框画出来
  68.   ;;然后把物体变换回到UCS,并把矩形也变换回去
  69.   (and UcsFlag (vla-TransformBy obj revMat))          ;反变换到WCS
  70.   (vla-GetBoundingBox obj 'np 'xp)                  ;得到包围框
  71.   (setq nP (vlax-safearray->list nP))                  ;取得第1点
  72.   (setq xP (vlax-safearray->list xP))                  ;取得第9点
  73.   (and UcsFlag (vla-TransformBy obj matrix))          ;变换回到UCS

  74.   (setq p6 (list (car xp) (cadr np) 0.0))
  75.   (setq        xd (distance np p6)
  76.         yd (distance xp p6)
  77.   )
  78.   (list        (polar np (* pi 0.5) yd)
  79.         (polar xp 0 (* xd 0.5))
  80.         xp
  81.         (polar np (* pi 0.5) (* yd 0.5))
  82.         (list (+ (car np) (* xd 0.5)) (+ (cadr np) (* yd 0.5)) 0.0)
  83.         (polar xp (* 1.5 pi) (* yd 0.5))
  84.         np
  85.         (polar np (* pi 2) (* xd 0.5))
  86.         p6

  87.   )
  88. )
  89. ;|
  90. (defun get-utime()(* 86400.0 (getvar"tdusrtimer")))
  91. (defun c:xx (/ i s1 ss t1 t2)
  92.   (setq ss (ssget '((0 . "text")))
  93.         i -1
  94.   )
  95.   (setq t1 (get-utime))
  96.   (while (setq s1 (ssname ss (setq i (1+ i))))
  97.    (mapcar '(lambda (x) (xx-9pt s1 x)) '(1 2 3 4 5 6 7 8 9))
  98.   )
  99.   (setq t2 (get-utime))
  100.   (PRINC (list 0 0 (- t2 t1)))
  101.   (princ)
  102. )
  103. |;
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2013-9-12 15:03:35 | 显示全部楼层
Love-Lisp 发表于 2013-9-12 13:18
9点的位置顺序定义,最好要和MTEXT 附着点的顺序一致:这样取得位置点后方便后续编程利用!

MTEXT和TABLE实体都是有个生成方向属性 FlowDirection 的,默认是从上到下的。也可以设置从下到上的,这样第一个点就是左下点了。

大多数实体的方向都是左下点开始的,这样也符合习惯。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-9-12 15:54:56 来自手机 | 显示全部楼层
这个层面是应用,没必要到理论啊效率的,批量到一定就是小众应用
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 685个

财富等级: 财运亨通

发表于 2013-9-12 20:20:37 | 显示全部楼层

支持这种小键盘排位法~~~~对于我们这些E文不懂的人来说很容易记
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

发表于 2013-9-16 15:48:32 | 显示全部楼层
炫版,你这个还没有完3,考虑转角怎么写呀?

点评

网站一直很慢,没有...对于角度的,我没还没打算研究 初步思路,是用得到点再进行根据角度选取点  发表于 2013-9-16 17:55
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

发表于 2013-9-17 14:03:28 | 显示全部楼层
  1. ;;下面这段代码是用Highflybird的包围盒改的。
  2. ;;为了在ucs下画中心,比如旋转后的矩形,求得对象的周围9点是必要的,但为了这么一个程序加载XD的api函数,似乎有点小题大作
  3. ;;看了两天Highflybird的矩阵和trans,不能悟透。

  4. (defun c:w1 (/ ENT I MATLST MATRIX MAXPT MINPT OBJ ORIGIN REVMAT SEL UCSFLAG WCSORG XDIR YDIR ZDIR)
  5.   ;;矩阵的变换与逆变换
  6.   (defun GetMatrix (lst org Revflag / mat i j)
  7.     (setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3)))
  8.                                                   ;初始化一个4X4的矩阵
  9.     (setq i 0)
  10.     (repeat 3
  11.       (vlax-safearray-put-element mat i 3 (nth i org)) ;平移变换
  12.       (setq j 0)
  13.       (repeat 3
  14.         (if RevFlag
  15.           (vlax-safearray-put-element mat i j (nth j (nth i lst))) ;角度逆变换
  16.           (vlax-safearray-put-element mat i j (nth i (nth j lst))) ;角度的变换
  17.         )
  18.         (setq j (1+ j))
  19.       )
  20.       (setq i (1+ i))
  21.     )
  22.     (vlax-safearray-put-element mat 3 3 1)
  23.     mat                                                  ;返回矩阵
  24.   )
  25.   ;;构造矩形
  26.   (defun Make-Rectange (pt1 pt2)
  27.     (entmake
  28.       (list
  29.         '(0 . "LWPOLYLINE")                          ;轻多段线
  30.         '(100 . "AcDbEntity")
  31.         '(100 . "AcDbPolyline")
  32.         '(90 . 4)                                  ;四个顶点
  33.         '(70 . 1)                                  ;闭合
  34.         (cons 38 (caddr pt1))                          ;高程
  35.         (cons 10 (list (car pt1) (cadr pt1)))          ;左下角
  36.         (cons 10 (list (car pt2) (cadr pt1)))          ;右下角
  37.         (cons 10 (list (car pt2) (cadr pt2)))          ;右上角
  38.         (cons 10 (list (car pt1) (cadr pt2)))          ;左上角
  39.         (cons 210 '(0 0 1))                          ;法线方向
  40.       )
  41.     )
  42.   )

  43.   ;;在UCS下先变换物体到WCS下,取得每个物体的包围框,
  44.   ;;求出包围框集合的最小XY,最大XY,并用矩形框画出来
  45.   ;;然后把物体变换回到UCS,并把矩形也变换回去
  46.   (if (setq ent (car (entsel)))
  47.     ;;选择物体
  48.     (progn
  49.       (setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2))) ;左下角点
  50.       (setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2))) ;右上角点
  51.       
  52.       (command "_.UCS" "NEW" "Object" ent)
  53.       
  54.       ;;先判断UCS是否与WCS相同。如是则取得UCS的X方向,
  55.       ;;Y方向,Z方向,UCS原点及WCS的原点相对UCS的坐标点
  56.       ;;然后得到UCS变换矩阵和到WCS的逆变换矩阵
  57.       (setq UcsFlag (getvar "WORLDUCS"))
  58.       (if (= UcsFlag 0)                                  ;UCS是否与WCS相同
  59.         (setq UcsFlag T                                  ;设置标志位为true
  60.               xdir    (getvar "UCSXDIR")          ;X方向矢量
  61.               ydir    (getvar "UCSYDIR")          ;Y方向矢量
  62.               zdir    (MAT:vxv xdir ydir)          ;X和Y的方向矢量的叉积
  63.               origin  (getvar "UCSORG")                  ;原点
  64.               WcsOrg  (trans '(0 0 0) 0 1)          ;WCS的原点相对UCS的坐标
  65.               matLst  (list xdir ydir zdir)          ;旋转的变换矩阵表
  66.               matrix  (GetMatrix matLst origin nil) ;从WCS到UCS的变换矩阵
  67.               revMat  (GetMatrix matLst WcsOrg T) ;从UCS到WCS的变换矩阵
  68.         )
  69.         (setq UcsFlag nil)                          ;否则不予变换
  70.       )
  71.       (setq obj (vlax-ename->vla-object ent))          ;obj对象
  72.       (and UcsFlag (vla-TransformBy obj revMat))  ;反变换到WCS
  73.       (vla-GetBoundingBox obj 'minpt 'maxpt)          ;得到包围框
  74.       (setq minPt (vlax-safearray->list minPt))
  75.       (setq maxPt (vlax-safearray->list maxPt))
  76.       (and UcsFlag (vla-TransformBy obj matrix))  ;变换回到UCS

  77.       (command "_.UCS" "P")      

  78.       (and
  79.         (make-Rectange minPt maxPt)                  ;构造边框
  80.         UcsFlag                                          ;如果UCS的话
  81.         (vla-TransformBy
  82.           (vlax-ename->vla-object (entlast))
  83.           matrix                                  ;变换边框到UCS
  84.         )
  85.       )
  86.     )
  87.   )
  88.   (princ)
  89. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 604个

财富等级: 财运亨通

发表于 2013-9-17 14:05:55 | 显示全部楼层

  1. ;;下面这段代码是用Highflybird的包围盒改的。
  2. ;;为了在ucs下画中心,比如旋转后的矩形,求得对象的周围9点是必要的,但为了这么一个程序加载XD的api函数,似乎有点小题大作
  3. ;;看了两天Highflybird的矩阵和trans,不能悟透。

  4. (defun c:w1 (/ ENT I MATLST MATRIX MAXPT MINPT OBJ ORIGIN REVMAT SEL UCSFLAG WCSORG XDIR YDIR ZDIR)
  5.   ;;矩阵的变换与逆变换
  6.   (defun GetMatrix (lst org Revflag / mat i j)
  7.     (setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3)))
  8.                                                   ;初始化一个4X4的矩阵
  9.     (setq i 0)
  10.     (repeat 3
  11.       (vlax-safearray-put-element mat i 3 (nth i org)) ;平移变换
  12.       (setq j 0)
  13.       (repeat 3
  14.         (if RevFlag
  15.           (vlax-safearray-put-element mat i j (nth j (nth i lst))) ;角度逆变换
  16.           (vlax-safearray-put-element mat i j (nth i (nth j lst))) ;角度的变换
  17.         )
  18.         (setq j (1+ j))
  19.       )
  20.       (setq i (1+ i))
  21.     )
  22.     (vlax-safearray-put-element mat 3 3 1)
  23.     mat                                                  ;返回矩阵
  24.   )
  25.   ;;构造矩形
  26.   (defun Make-Rectange (pt1 pt2)
  27.     (entmake
  28.       (list
  29.         '(0 . "LWPOLYLINE")                          ;轻多段线
  30.         '(100 . "AcDbEntity")
  31.         '(100 . "AcDbPolyline")
  32.         '(90 . 4)                                  ;四个顶点
  33.         '(70 . 1)                                  ;闭合
  34.         (cons 38 (caddr pt1))                          ;高程
  35.         (cons 10 (list (car pt1) (cadr pt1)))          ;左下角
  36.         (cons 10 (list (car pt2) (cadr pt1)))          ;右下角
  37.         (cons 10 (list (car pt2) (cadr pt2)))          ;右上角
  38.         (cons 10 (list (car pt1) (cadr pt2)))          ;左上角
  39.         (cons 210 '(0 0 1))                          ;法线方向
  40.       )
  41.     )
  42.   )

  43.   ;;在UCS下先变换物体到WCS下,取得每个物体的包围框,
  44.   ;;求出包围框集合的最小XY,最大XY,并用矩形框画出来
  45.   ;;然后把物体变换回到UCS,并把矩形也变换回去
  46.   (if (setq ent (car (entsel)))
  47.     ;;选择物体
  48.     (progn
  49.       (setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2))) ;左下角点
  50.       (setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2))) ;右上角点
  51.       
  52.       (command "_.UCS" "NEW" "Object" ent)
  53.       
  54.       ;;先判断UCS是否与WCS相同。如是则取得UCS的X方向,
  55.       ;;Y方向,Z方向,UCS原点及WCS的原点相对UCS的坐标点
  56.       ;;然后得到UCS变换矩阵和到WCS的逆变换矩阵
  57.       (setq UcsFlag (getvar "WORLDUCS"))
  58.       (if (= UcsFlag 0)                                  ;UCS是否与WCS相同
  59.         (setq UcsFlag T                                  ;设置标志位为true
  60.               xdir    (getvar "UCSXDIR")          ;X方向矢量
  61.               ydir    (getvar "UCSYDIR")          ;Y方向矢量
  62.               zdir    (MAT:vxv xdir ydir)          ;X和Y的方向矢量的叉积
  63.               origin  (getvar "UCSORG")                  ;原点
  64.               WcsOrg  (trans '(0 0 0) 0 1)          ;WCS的原点相对UCS的坐标
  65.               matLst  (list xdir ydir zdir)          ;旋转的变换矩阵表
  66.               matrix  (GetMatrix matLst origin nil) ;从WCS到UCS的变换矩阵
  67.               revMat  (GetMatrix matLst WcsOrg T) ;从UCS到WCS的变换矩阵
  68.         )
  69.         (setq UcsFlag nil)                          ;否则不予变换
  70.       )
  71.       (setq obj (vlax-ename->vla-object ent))          ;obj对象
  72.       (and UcsFlag (vla-TransformBy obj revMat))  ;反变换到WCS
  73.       (vla-GetBoundingBox obj 'minpt 'maxpt)          ;得到包围框
  74.       (setq minPt (vlax-safearray->list minPt))
  75.       (setq maxPt (vlax-safearray->list maxPt))
  76.       (and UcsFlag (vla-TransformBy obj matrix))  ;变换回到UCS

  77.       (command "_.UCS" "P")      

  78.       (and
  79.         (make-Rectange minPt maxPt)                  ;构造边框
  80.         UcsFlag                                          ;如果UCS的话
  81.         (vla-TransformBy
  82.           (vlax-ename->vla-object (entlast))
  83.           matrix                                  ;变换边框到UCS
  84.         )
  85.       )
  86.     )
  87.   )
  88.   (princ)
  89. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-9-22 10:34:45 | 显示全部楼层
  1. (defun xx-9pt (s1 mode / DX DY MAXP MAXPOINT MINP MINPOINT PT PTS X1 X2 Y1 Y2)
  2.   (setq s1 (vlax-ename->vla-object s1))
  3.   (vla-getboundingbox s1 'minpoint 'maxpoint)
  4.   (setq maxp (vlax-safearray->list maxpoint)        ;取得第9点
  5.         minp (vlax-safearray->list minpoint);取得第1点
  6.         x1  (car minp)
  7.         x2  (car maxp)
  8.         y1  (cadr minp)
  9.         y2  (cadr maxp)
  10.         dx  (* (+ x2 x1) 0.5)
  11.         dy  (* (+ y2 y1) 0.5)
  12.         pts (list minp             ;1
  13.                   (list dx y1)     ;2
  14.                   (list x2 y1)     ;3
  15.                   (list x1 dy)     ;4
  16.                   (list dx dy)     ;5
  17.                   (list x2 dy)     ;6
  18.                   (list x1 y2)     ;7
  19.                   (list dx y2)     ;8
  20.                   maxp             ;9
  21.                   )
  22.         )
  23.   (if (<= 1 mode 9)
  24.     (nth (1- mode) pts)
  25.     minp
  26.     )
  27.   )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2013-9-22 11:09:46 | 显示全部楼层
本帖最后由 lijiao 于 2013-9-22 11:12 编辑
  1. (defun xx-9pt (s1 mode / MAXPOINT MINPOINT PTS X Y)
  2.   (setq s1 (vlax-ename->vla-object s1))
  3.   (vla-getboundingbox s1 'minpoint 'maxpoint)
  4.   (setq minpoint (vlax-safearray->list minpoint)
  5.         maxpoint (vlax-safearray->list maxpoint))
  6.   (setq pts (list minpoint (mapcar '(lambda (x y) (* 0.5 (+ x y))) minpoint maxpoint) maxpoint))
  7.   (setq pts (apply 'append (mapcar '(lambda(y)
  8.                        (mapcar '(lambda(x)
  9.                                   (list x y))
  10.                                (mapcar 'car pts))
  11.                        )
  12.                     (mapcar 'cadr pts)
  13.                     )
  14.                    )
  15.         )
  16.   (if (<= 1 mode 9)
  17.     (nth (1- mode) pts)
  18.     (car pts)
  19.     )
  20.   )

点评

不过速度还较慢些  发表于 2013-9-22 14:00

评分

参与人数 1D豆 +5 收起 理由
炫翔 + 5 技术引导讨论和指点奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-9-25 06:28 , Processed in 0.440769 second(s), 53 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表