统计圆的交集次数及填充

bbswen · 发表于 2014-8-24 12:51:05

csharp 发表于 2014-8-23 12:16
记录每个圆心位置，生成的 Region 的质心和圆心的距离与覆盖半径比较，有几个小于半径的就是在几个圆内
...

   由质心和圆心列表逐一比较找出小于半径的圆心数量和 Region 构造表
对 Rgion 和数量表遍历
   由 Region 生成 Hatch
   由数量设置 Hatch 颜色

那我应该就是这里没有搞清楚了，

是不是可以理解为，这里的交集归属于谁，是由，组成的面域的质心到圆心的距离来判断的，
只要小于圆的半径，就可以视为这个面域就是在这个圆内了，

bbswen · 发表于 2014-8-24 13:01:23

非常感谢，
麻烦看下，我说的那个问题是怎么产生的，为什么会产生多余的面域

另外我有一想法，应该可以提高很高倍的速度，圆内点很多时应该很有用。

请高手尝试下，

在比较面域的质心和圆心时，增加一个圆心集合。

以当前面域的各顶点为圆心，以圆的半径为半径，添加到一个集合中，

判断时只与这个集合中和圆心进行比较，循环量就会只有一小部分，应该可以提高很多效率。

能否按这个修改下。

csharp · 发表于 2014-8-24 15:05:36

bbswen 发表于 2014-8-24 13:01
非常感谢，
麻烦看下，我说的那个问题是怎么产生的，为什么会产生多余的面域

有面域了，取质心很简单
xdrxapi的慢在了交点断开一步，其它步骤很快的

q3_2006 · 发表于 2014-8-24 15:45:21

LISP交点打断速度只能这样了...没办法...我也这里慢....{:soso_e110:}

csharp · 发表于 2014-8-24 15:51:42

本帖最后由 csharp 于 2014-8-24 15:53 编辑

q3_2006 发表于 2014-8-24 15:45
LISP交点打断速度只能这样了...没办法...我也这里慢....

肯定函数有问题！测试C#写的那个LispFunction 交点断开比api这个函数在这个应用上要快的多

q3_2006 · 发表于 2014-8-24 16:10:33

....C#...不懂....没法比较...{:soso_e110:}

bbswen · 发表于 2014-8-24 19:38:05

郁闷，家里的电脑，xp cad2007 无法加载xd的api

郁闷，无法测试到底要多长时间，

同样多的圆如试验图中的数量，lisp 的打断时间，500ms左右，眼睛都没眨下，就完了，

csharp · 发表于 2014-8-24 19:46:39

bbswen 发表于 2014-8-24 19:38
郁闷，家里的电脑，xp cad2007 无法加载xd的api

郁闷，无法测试到底要多长时间，

500ms ？你怎么打断的

csharp · 发表于 2014-8-24 20:13:01

q3_2006 发表于 2014-8-24 16:10
....C#...不懂....没法比较...

C#定义的LispFunction和ARX定义lisp函数一样，效率比ARX差一点点，但比仅榜着alisp要强太多了！

q3_2006 · 发表于 2014-8-25 08:02:32

csharp 发表于 2014-8-24 20:13
C#定义的LispFunction和ARX定义lisp函数一样，效率比ARX差一点点，但比仅榜着alisp要强太多了！

E大也这样说...我太懒..没动力学....感觉LISP目前够用...

bbswen · 发表于 2014-8-25 09:13:50

csharp 发表于 2014-8-24 19:46
500ms ？你怎么打断的

这是我在网上找到的程序

;;主函数
(defun c:MBB (/ elist ssg n t0)
(VL-LOAD-COM)
;;; (setq t0 (xdl-getutime))
(if (setq ssg (ssget '((0 . "line,arc,circle,ellipse"))))
(progn (setq t0 (xdl-getutime))
(vlax-for obj (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
(setq elist (cons obj elist)) ; ssg->elist
)
)
)
(DoEntMake (InterSort (ssinter elist)))
(princ (strcat "\n*****找到交点"
(itoa n)
"个，交点断开操作共耗时"
(rtos (- (xdl-getutime) t0) 2 3)
"秒。*****"
)
)
(princ)
)
;;求交点集函数－nth
;;经过测试，nth函数仅比assoc函数快一点点。
;;故此函数也可取消i，j变量，直接使用assoc函数
(defun ssinter (el / el1 obj1 obj2 ipts pts list1 outlst i j)
(setq outlst (mapcar 'list el)
i -1 ;obj1位置指针
n 0 ;交点数计数器
)
(while el
(setq obj1 (car el)
list1 (nth (setq i (1+ i)) outlst) ;obj1已有的交点列表
el (cdr el)
el1 el
j i ;obj2位置指针
)
(while el1
(setq obj2 (car el1)
el1 (cdr el1)
j (1+ j)
)
;;取交点
(if (and (setq ipts (vla-intersectwith obj1 obj2 0))
(setq ipts (vlax-variant-value ipts))
(> (vlax-safearray-get-u-bound ipts 1) 0)
)
(progn
(setq ipts (vlax-safearray->list ipts)
pts '() ;obj1,obj2交点临时列表变量
)
(while (> (length ipts) 0)
(setq pts (cons (list (car ipts)
(cadr ipts)
(caddr ipts)
)
pts
)
ipts (cdddr ipts)
)
)
(setq list1 (append list1 pts) ;存obj1交点表，循环结束后再更新
n (+ n (length pts)) ;交点计数累加
)
;;obj2的交点列表立即更新
(setq
outlst (subst (append (nth j outlst) pts)
(nth j outlst)
outlst
)
)
)
)
)
;;当obj1存在交点，且非封闭曲线，添加两端点
(if (and (cdr list1) (not (vlax-curve-isClosed obj1)))
(setq list1 (append list1
(list (vlax-curve-getEndPoint obj1))
(list (vlax-curve-getStartPoint obj1))
)
)
)
(setq outlst (subst list1 (nth i outlst) outlst)) ;更新obj1交点列表
)
outlst
)
;;点集排序及删除重复点函数
(defun InterSort (el / obj1 pts plst outlst)
(setq outlst '()) ;empty list
(foreach item el
(setq obj1 (car item)
pts (cdr item)
plst '() ;empty list
)
(if pts ;若无交点，则不修改该实体
(progn
;;交点排序，列表为逆序
(setq
pts (vl-sort
pts
(function (lambda (p1 p2)
(< (vlax-curve-getParamAtPoint obj1 p1)
(vlax-curve-getParamAtPoint obj1 p2)
)
)
)
)
)
;;剔除重复点并将列表顺序转正
(foreach p pts
(if plst
(if (not (equal p (car plst) 0.00001))
(setq plst (cons p plst))
)
(setq plst (cons p plst))
)
)
;;闭合曲线需再添加首个交点以使新实体完全封闭
(if (vlax-curve-isClosed obj1)
(setq plst (cons (last plst) plst))
)
(setq plst (cons (vlax-vla-object->ename obj1) plst)
outlst (cons plst outlst)
)
)
)
)
outlst
)
;;调用entmake生成新实体
(defun DoEntMake (el / obj objlst objname objcen objratio objaxis)
(foreach e el
(setq obj (car e)
objlst (entget obj)
objlst (vl-remove (assoc -1 objlst) objlst) ;去除图元名
objlst (vl-remove (assoc 330 objlst) objlst) ;去除id
objlst (vl-remove (assoc 5 objlst) objlst) ;去除句柄
objname (cdr (assoc 0 objlst))
)
(cond
((= objname "LINE")
(repeat (- (length e) 2)
(setq e (cdr e))
(setq objlst (subst (cons 10 (car e)) (assoc 10 objlst) objlst))
(setq objlst (subst (cons 11 (cadr e)) (assoc 11 objlst) objlst))
(entmake objlst)
)
(entdel obj)
)
((= objname "CIRCLE")
(setq objcen (cdr (assoc 10 objlst)))
(setq objlst (subst (cons 0 "ARC") (assoc 0 objlst) objlst))
(setq objlst (append objlst
(list (cons 100 "AcDbArc")
(cons 50 0.0)
(cons 51 0.0)
)
)
)
(repeat (- (length e) 2)
(setq e (cdr e))
(setq objlst (subst (cons 50 (angle objcen (cadr e)))
(assoc 50 objlst)
objlst
)
)
(setq objlst (subst (cons 51 (angle objcen (car e)))
(assoc 51 objlst)
objlst
)
)
(entmake objlst)
)
(entdel obj)
)
((= objname "ARC")
(setq objcen (cdr (assoc 10 objlst)))
(repeat (- (length e) 2)
(setq e (cdr e))
(setq objlst (subst (cons 50 (angle objcen (cadr e)))
(assoc 50 objlst)
objlst
)
)
(setq objlst (subst (cons 51 (angle objcen (car e)))
(assoc 51 objlst)
objlst
)
)
(entmake objlst)
)
(entdel obj)
)
((= objname "ELLIPSE")
;;椭圆圆心
(setq objcen (cdr (assoc 10 objlst)))
;;相对于中心的长轴矢量
(setq objaxis (cdr (assoc 11 objlst)))
;;短轴与长轴的比例
(setq objratio (cdr (assoc 40 objlst)))
(repeat (- (length e) 2)
(setq e (cdr e))
(setq objlst (subst (cons 41 (pt->param (cadr e) objcen objaxis objratio))
(assoc 41 objlst)
objlst
)
)
(setq objlst (subst (cons 42 (pt->param (car e) objcen objaxis objratio))
(assoc 42 objlst)
objlst
)
)
(entmake objlst)
)
(entdel obj)
)
)
)
)
;;计算耗时
(defun xdl-getutime ()
(* 86400 (getvar "tdusrtimer"))
)
;;求椭圆曲线参数
(defun pt->param (pt cen axis ratio / ang param)
(setq ang (- (angle cen pt) (angle '(0. 0. 0.) axis)))
(cond ((= (cos ang) 0.0) ;防止分母cos为零出错
(if (> (sin ang) 0.0)
(setq param (* 0.5 PI))
(setq param (* 1.5 PI))
)
)
((= (sin ang) 0.0)
(if (> (cos ang) 0.0)
(setq param 0.0)
(setq param PI)
)
)
(T
(setq param (atan (/ (sin ang) (* (cos ang) ratio))))
(if (< (cos ang) 0.0)
(setq param (+ pi param))
)
)
)
param
)
(princ)

;;主函数 
(defun c:MBB (/ elist ssg n t0) 
  (VL-LOAD-COM) 
;;;  (setq t0 (xdl-getutime)) 
  (if (setq ssg (ssget '((0 . "line,arc,circle,ellipse")))) 
     (progn (setq t0 (xdl-getutime)) 
    (vlax-for obj (vla-get-activeselectionset 
        (vla-get-activedocument (vlax-get-acad-object)) 
      ) 
      (setq elist (cons obj elist))  ; ssg->elist 
    ) 
    ) 
  ) 
  (DoEntMake (InterSort (ssinter elist))) 
  (princ (strcat "\n*****找到交点" 
     (itoa n) 
     "个，交点断开操作共耗时" 
     (rtos (- (xdl-getutime) t0) 2 3) 
     "秒。*****" 
   ) 
  ) 
  (princ) 
) 
;;求交点集函数－nth 
;;经过测试，nth函数仅比assoc函数快一点点。 
;;故此函数也可取消i，j变量，直接使用assoc函数 
(defun ssinter (el / el1 obj1 obj2 ipts pts list1 outlst i j) 
  (setq outlst (mapcar 'list el) 
 i      -1   ;obj1位置指针 
 n      0   ;交点数计数器 
  ) 
  (while el 
    (setq obj1 (car el) 
   list1 (nth (setq i (1+ i)) outlst) ;obj1已有的交点列表 
   el (cdr el) 
   el1 el 
   j i   ;obj2位置指针 
    ) 
    (while el1 
      (setq obj2 (car el1) 
     el1  (cdr el1) 
     j  (1+ j) 
      ) 
      ;;取交点 
      (if (and (setq ipts (vla-intersectwith obj1 obj2 0)) 
        (setq ipts (vlax-variant-value ipts)) 
        (> (vlax-safearray-get-u-bound ipts 1) 0) 
   ) 
 (progn 
   (setq ipts (vlax-safearray->list ipts) 
  pts  '()  ;obj1,obj2交点临时列表变量 
   ) 
   (while (> (length ipts) 0) 
     (setq pts  (cons (list (car ipts) 
       (cadr ipts) 
       (caddr ipts) 
        ) 
        pts 
         ) 
    ipts (cdddr ipts) 
     ) 
   ) 
   (setq list1 (append list1 pts) ;存obj1交点表，循环结束后再更新 
  n     (+ n (length pts)) ;交点计数累加 
   ) 
   ;;obj2的交点列表立即更新 
   (setq 
     outlst (subst (append (nth j outlst) pts) 
     (nth j outlst) 
     outlst 
     ) 
   ) 
 ) 
      ) 
    ) 
    ;;当obj1存在交点，且非封闭曲线，添加两端点 
    (if (and (cdr list1) (not (vlax-curve-isClosed obj1))) 
      (setq list1 (append list1 
     (list (vlax-curve-getEndPoint obj1)) 
     (list (vlax-curve-getStartPoint obj1)) 
    ) 
      ) 
    ) 
    (setq outlst (subst list1 (nth i outlst) outlst)) ;更新obj1交点列表 
  ) 
  outlst 
) 
;;点集排序及删除重复点函数 
(defun InterSort (el / obj1 pts plst outlst) 
  (setq outlst '())   ;empty list 
  (foreach item el 
    (setq obj1 (car item) 
   pts  (cdr item) 
   plst '()   ;empty list 
    ) 
    (if pts    ;若无交点，则不修改该实体 
      (progn 
 ;;交点排序，列表为逆序 
 (setq 
   pts (vl-sort 
  pts 
  (function (lambda (p1 p2) 
       (< (vlax-curve-getParamAtPoint obj1 p1) 
          (vlax-curve-getParamAtPoint obj1 p2) 
       ) 
     ) 
  ) 
       ) 
 ) 
 ;;剔除重复点并将列表顺序转正 
 (foreach p pts 
   (if plst 
     (if (not (equal p (car plst) 0.00001)) 
       (setq plst (cons p plst)) 
     ) 
     (setq plst (cons p plst)) 
   ) 
 ) 
 ;;闭合曲线需再添加首个交点以使新实体完全封闭 
 (if (vlax-curve-isClosed obj1) 
   (setq plst (cons (last plst) plst)) 
 ) 
 (setq plst   (cons (vlax-vla-object->ename obj1) plst) 
       outlst (cons plst outlst) 
 ) 
      ) 
    ) 
  ) 
  outlst 
) 
;;调用entmake生成新实体 
(defun DoEntMake (el / obj objlst objname objcen objratio objaxis) 
  (foreach e el 
    (setq obj   (car e) 
   objlst  (entget obj) 
   objlst  (vl-remove (assoc -1 objlst) objlst) ;去除图元名 
   objlst  (vl-remove (assoc 330 objlst) objlst) ;去除id 
   objlst  (vl-remove (assoc 5 objlst) objlst) ;去除句柄 
   objname (cdr (assoc 0 objlst)) 
    ) 
    (cond 
      ((= objname "LINE") 
       (repeat (- (length e) 2) 
  (setq e (cdr e)) 
  (setq objlst (subst (cons 10 (car e)) (assoc 10 objlst) objlst)) 
  (setq objlst (subst (cons 11 (cadr e)) (assoc 11 objlst) objlst)) 
  (entmake objlst) 
       ) 
       (entdel obj) 
      ) 
      ((= objname "CIRCLE") 
       (setq objcen (cdr (assoc 10 objlst))) 
       (setq objlst (subst (cons 0 "ARC") (assoc 0 objlst) objlst)) 
       (setq objlst (append objlst 
       (list (cons 100 "AcDbArc") 
      (cons 50 0.0) 
      (cons 51 0.0) 
       ) 
      ) 
       ) 
       (repeat (- (length e) 2) 
  (setq e (cdr e)) 
  (setq objlst (subst (cons 50 (angle objcen (cadr e))) 
        (assoc 50 objlst) 
        objlst 
        ) 
  ) 
  (setq objlst (subst (cons 51 (angle objcen (car e))) 
        (assoc 51 objlst) 
        objlst 
        ) 
  ) 
  (entmake objlst) 
       ) 
       (entdel obj) 
      ) 
      ((= objname "ARC") 
       (setq objcen (cdr (assoc 10 objlst))) 
       (repeat (- (length e) 2) 
  (setq e (cdr e)) 
  (setq objlst (subst (cons 50 (angle objcen (cadr e))) 
        (assoc 50 objlst) 
        objlst 
        ) 
  ) 
  (setq objlst (subst (cons 51 (angle objcen (car e))) 
        (assoc 51 objlst) 
        objlst 
        ) 
  ) 
  (entmake objlst) 
       ) 
       (entdel obj) 
      ) 
      ((= objname "ELLIPSE") 
       ;;椭圆圆心 
       (setq objcen (cdr (assoc 10 objlst))) 
       ;;相对于中心的长轴矢量 
       (setq objaxis (cdr (assoc 11 objlst))) 
       ;;短轴与长轴的比例 
       (setq objratio (cdr (assoc 40 objlst))) 
       (repeat (- (length e) 2) 
  (setq e (cdr e)) 
  (setq objlst (subst (cons 41 (pt->param (cadr e) objcen objaxis objratio)) 
        (assoc 41 objlst) 
        objlst 
        ) 
  ) 
  (setq objlst (subst (cons 42 (pt->param (car e) objcen objaxis objratio)) 
        (assoc 42 objlst) 
        objlst 
        ) 
  ) 
  (entmake objlst) 
       ) 
       (entdel obj) 
      ) 
    ) 
  ) 
) 
;;计算耗时 
(defun xdl-getutime () 
  (* 86400 (getvar "tdusrtimer")) 
) 
;;求椭圆曲线参数 
(defun pt->param (pt cen axis ratio / ang param) 
  (setq ang (- (angle cen pt) (angle '(0. 0. 0.) axis))) 
  (cond ((= (cos ang) 0.0)  ;防止分母cos为零出错 
  (if (> (sin ang) 0.0) 
    (setq param (* 0.5 PI)) 
    (setq param (* 1.5 PI)) 
  ) 
 ) 
 ((= (sin ang) 0.0) 
  (if (> (cos ang) 0.0) 
    (setq param 0.0) 
    (setq param PI) 
  ) 
 ) 
 (T 
  (setq param (atan (/ (sin ang) (* (cos ang) ratio)))) 
  (if (< (cos ang) 0.0) 
    (setq param (+ pi param)) 
  ) 
 ) 
  ) 
  param 
) 
(princ)

再修改下这个程序是不是就可以提高点速度了，麻烦整合下，呵呵

bbswen · 发表于 2014-8-26 16:14:30

有人测试过这没有？

eachy · 发表于 2014-8-26 17:56:12

bbswen 发表于 2014-8-26 16:14
有人测试过这没有？

以前写过 Curve 的 Ssbrk （源码在本论坛），Lisp 没法再快了，借助 ARX C# 或者直接用 ARX C# 才能更快

bbswen · 发表于 2014-8-26 20:16:38

没有配置过，arx的配置的真不知道arx难配置啊，

zinah · 发表于 2014-8-27 09:12:25

学习了。。。。。。。。。。。

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

[求助] 统计圆的交集次数及填充

点评

点评

点评

点评

点评

点评

点评