[原创]：交点断开------圆断开

eachy · 发表于 2004-3-24 12:58:57

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

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

×

;; 上班后书也看不进去，写个程序玩玩，也是不久前写的曲线断
;; 开的继续。其中有几处不足，当然所提出的不足在论坛上都有
;; 过讨论，大家可以搜索下，可能有答案也可能没有，有兴趣的
;; 参与下完善不足。积极参与者提议斑竹给与奖励
;; 为方便网友使用，附件系Vla方法"打断"圆的编译文件，
;; 两实体的交点，本函数没有过滤重合交点。在过滤重合点问题上
;; LUCAS曾经用 member 写过，但使用中发现达不到要求
(defun ea:ints (e1 e2 / pts ipts)
(setq ipts (vlax-variant-value
(vla-intersectwith
e1
e2
acExtendNone
)
)
)
(if (> (vlax-safearray-get-u-bound ipts 1) 0);是否有交点
(progn
(setq ipts
(vlax-safearray->list ipts)
)
(while (> (length ipts) 0)
(setq pts (cons (list (car ipts)
(cadr ipts)
(caddr ipts)
)
pts
);此处可以在添加时判断是否有重合点
)
(setq ipts (cdddr ipts))
)
)
)
pts ;也可以在这里单独去除重合点
)
;;基于实体的点的排序函数，就是有一系列点是在曲线实体上或外部，基于这个曲线实体，
;;从开始点到结束点排序这些点。结果是这些点依据实体的开始点开始排升序。
;;本函数用的是不去除重合点，实际中可能某些情况下要去除重合点
;;比如下面断开圆的应用中
(defun ea:SortPointOnCurve (points curve / pl1)
(setq pl1 (mapcar '(lambda (x /)
(vlax-curve-getparamatpoint
curve
(vlax-curve-getclosestpointto curve x)
)
)
points
)
)
(mapcar '(lambda (n) (nth n points))
(vl-sort-i pl1 '<)
)
)
;;
;;"断开"园的程序
;;
;; 使用了 Vla 方法和 Entmake
;|
AddArc Method
Creates an arc given the center, radius, start angle, and end angle of the arc.
Signature
RetVal = object.AddArc(Center, Radius, StartAngle, EndAngle)
StartAngle, EndAngle Double; input-only
The start and end angles, in radians, defining the arc.
A start angle greater than an end angle defines a
counterclockwise arc.
|;
;; Vla 方法
(defun c:BrkCr (/ line ssc thisdrawing modelspace intp cenpt lcen r)
(if (and (setq line (entsel "\n选择线: "))
(progn
(princ "\n选择园.....")
T
)
(setq ssc (ssget '((0 . "circle"))))
)
(progn
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))
modelspace (vla-get-modelspace thisdrawing)
)
;; ssget 后马上处理的话可以使用 ActiveSelectionSet 省去转换实体一步
(vlax-for circle (vla-get-activeselectionset thisdrawing)
;;本处没有去除重合点，可能造成程序失败
(setq intp (ea:SortPointOnCurve
(ea:ints (vlax-ename->vla-object (car line))
circle
)
circle
)
;;注意：当有很多交点时就要先用[点集沿曲线排序]函数对交点排序
intp (append intp
(list (car intp))
) ;闭合圆
cenpt (vla-get-center circle) ;center point , variant
lcen (vlax-safearray->list (vlax-variant-value cenpt))
;Lisp 点
r (vla-get-radius circle) ;半径
)
(vla-delete circle) ;删除圆
;循环一段段生成圆弧
;只要两个交点时才可以
(while (and (> (length intp) 1)
(not (equal (angle lcen (car intp))
(angle lcen (cadr intp))
0.001
)
)
) ;交点中没有过滤，这里就要加判断
(vla-addarc
modelspace
cenpt
r
(angle lcen (car intp))
(angle lcen (cadr intp))
)
;此处 startangle endangle 是不能相等的
;相等了就是 Circle 了
(setq intp (cdr intp))
)
)
)
)
(princ)
)
;; 混合方法生成 Arc 用 Entmake 方法
(defun c:test1 (/ line circle clst intp cenpt ssc n)
(if (and (setq line (entsel "\n选择线: "))
(progn
(princ "\n选择园.....")
T
)
(setq ssc (ssget '((0 . "circle"))))
)
(progn
(setq n 0
ssl (sslength ssc)
)
(repeat ssl
(setq circle (ssname ssc n))
(setq intp (ea:SortPointOnCurve
(ea:ints (vlax-ename->vla-object (car line))
(vlax-ename->vla-object circle)
)
(vlax-ename->vla-object circle)
)
clst (entget circle)
intp (append intp
(list (car intp))
)
cenpt (cdr (assoc 10 clst))
)
(entdel circle)
(while (and (> (length intp) 1)
(not (equal (angle cenpt (car intp))
(angle cenpt (cadr intp))
0.001
)
)
)
;;entmake 方法
(entmake (list '(0 . "ARC")
'(100 . "AcDbEntity")
'(100 . "AcDbCircle")
(assoc 10 clst)
(assoc 40 clst)
'(100 . "AcDbArc")
(cons 50 (angle cenpt (car intp)))
(cons 51 (angle cenpt (cadr intp)))
)
)
(setq intp (cdr intp))
)
(setq n (1+ n))
)
)
)
(princ)
)

;; 上班后书也看不进去，写个程序玩玩，也是不久前写的曲线断 
;; 开的继续。其中有几处不足，当然所提出的不足在论坛上都有 
;; 过讨论，大家可以搜索下，可能有答案也可能没有，有兴趣的 
;; 参与下完善不足。积极参与者提议斑竹给与奖励 
 
;; 为方便网友使用，附件系Vla方法"打断"圆的编译文件， 
 
;; 两实体的交点，本函数没有过滤重合交点。在过滤重合点问题上 
;; LUCAS曾经用 member 写过 ，但使用中发现达不到要求 
 
(defun ea:ints (e1 e2 / pts ipts) 
  (setq        ipts (vlax-variant-value 
               (vla-intersectwith 
                 e1 
                 e2 
                 acExtendNone 
               ) 
             ) 
  ) 
  (if (> (vlax-safearray-get-u-bound ipts 1) 0);是否有交点 
    (progn 
      (setq ipts 
             (vlax-safearray->list ipts) 
      ) 
      (while (> (length ipts) 0) 
        (setq pts (cons        (list (car ipts) 
                              (cadr ipts) 
                              (caddr ipts) 
                        ) 
                        pts 
                  );此处可以在添加时判断是否有重合点 
        ) 
        (setq ipts (cdddr ipts)) 
      ) 
    ) 
  ) 
  pts                                        ;也可以在这里单独去除重合点 
) 
;;基于实体的点的排序函数，就是有一系列点是在曲线实体上或外部，基于这个曲线实体， 
;;从开始点到结束点排序这些点。结果是这些点依据实体的开始点开始排升序。 
;;本函数用的是不去除重合点，实际中可能某些情况下要去除重合点 
;;比如下面断开圆的应用中 
(defun ea:SortPointOnCurve (points curve / pl1) 
  (setq        pl1 (mapcar '(lambda (x /) 
                       (vlax-curve-getparamatpoint 
                         curve 
                         (vlax-curve-getclosestpointto curve x) 
                       ) 
                     ) 
                    points 
            ) 
  ) 
  (mapcar '(lambda (n) (nth n points)) 
            (vl-sort-i pl1 '<)           
  ) 
) 
;; 
;;"断开"园的程序 
;; 
;; 使用了 Vla 方法 和 Entmake 
;| 
 
AddArc Method 
 
Creates an arc given the center, radius, start angle, and end angle of the arc. 
 
Signature 
 
RetVal = object.AddArc(Center, Radius, StartAngle, EndAngle) 
 
StartAngle, EndAngle   Double; input-only 
 
                       The start and end angles, in radians, defining the arc. 
                       A start angle greater than an end angle defines a 
                       counterclockwise arc. 
|; 
;; Vla 方法 
(defun c:BrkCr (/ line ssc thisdrawing modelspace intp cenpt lcen r) 
  (if (and (setq line (entsel "\n选择线: ")) 
           (progn 
             (princ "\n选择园.....") 
             T 
           ) 
           (setq ssc (ssget '((0 . "circle")))) 
      ) 
    (progn 
      (setq thisdrawing        (vla-get-activedocument (vlax-get-acad-object)) 
            modelspace        (vla-get-modelspace thisdrawing) 
      ) 
      ;; ssget 后马上处理的话可以使用 ActiveSelectionSet 省去转换实体一步 
      (vlax-for        circle (vla-get-activeselectionset thisdrawing) 
        ;;本处没有去除重合点，可能造成程序失败 
        (setq intp  (ea:SortPointOnCurve 
                      (ea:ints (vlax-ename->vla-object (car line)) 
                               circle 
                      ) 
                      circle 
                    ) 
              ;;注意：当有很多交点时就要先用[点集沿曲线排序]函数对交点排序 
              intp  (append intp 
                            (list (car intp)) 
                    )                        ;闭合圆 
              cenpt (vla-get-center circle) ;center point , variant 
              lcen  (vlax-safearray->list (vlax-variant-value cenpt)) 
                                        ;Lisp 点 
              r            (vla-get-radius circle) ;半径 
        ) 
        (vla-delete circle)                ;删除圆 
                                        ;循环一段段生成圆弧 
                                        ;只要两个交点时才可以 
        (while (and (> (length intp) 1) 
                    (not (equal        (angle lcen (car intp)) 
                                (angle lcen (cadr intp)) 
                                0.001 
                         ) 
                    ) 
               )                        ;交点中没有过滤，这里就要加判断 
            (vla-addarc 
              modelspace 
              cenpt 
              r 
              (angle lcen (car intp)) 
              (angle lcen (cadr intp)) 
            ) 
                                        ;此处 startangle endangle 是不能相等的 
                                        ;相等了就是 Circle 了 
          (setq intp (cdr intp)) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
) 
;; 混合方法 生成 Arc 用 Entmake 方法 
(defun c:test1 (/ line circle clst intp cenpt ssc n) 
  (if (and (setq line (entsel "\n选择线: ")) 
           (progn 
             (princ "\n选择园.....") 
             T 
           ) 
           (setq ssc (ssget '((0 . "circle")))) 
      ) 
    (progn 
      (setq n        0 
            ssl        (sslength ssc) 
      ) 
      (repeat ssl 
        (setq circle (ssname ssc n)) 
        (setq intp  (ea:SortPointOnCurve 
                      (ea:ints (vlax-ename->vla-object (car line)) 
                               (vlax-ename->vla-object circle) 
                      ) 
                      (vlax-ename->vla-object circle) 
                    ) 
              clst  (entget circle) 
              intp  (append intp 
                            (list (car intp)) 
                    ) 
              cenpt (cdr (assoc 10 clst)) 
        ) 
        (entdel circle) 
        (while (and (> (length intp) 1) 
                    (not (equal        (angle cenpt (car intp)) 
                                (angle cenpt (cadr intp)) 
                                0.001 
                         ) 
                    ) 
               ) 
          ;;entmake 方法 
          (entmake (list '(0 . "ARC") 
                         '(100 . "AcDbEntity") 
                         '(100 . "AcDbCircle") 
                         (assoc 10 clst) 
                         (assoc 40 clst) 
                         '(100 . "AcDbArc") 
                         (cons 50 (angle cenpt (car intp))) 
                         (cons 51 (angle cenpt (cadr intp))) 
                   ) 
          ) 
          (setq intp (cdr intp)) 
        ) 
        (setq n (1+ n)) 
      ) 
    ) 
  ) 
  (princ) 
)

lsjjm · 发表于 2004-3-24 14:46:05

为了切磋交流，希望最好把命题的已知条件，最后的要求说清楚，不然编程时总会遗漏这，忘掉那？

梦断江南 · 发表于 2004-4-4 11:21:16

生成arc这一步，可用circle的实体表，然后替换，删除部分不要的信息，这样能更方便保持circle的其它属性，如颜色。
你这样处理，准确的表述是“断开到当前层".

eachy · 发表于 2004-4-4 11:34:35

最初由梦断江南发布
[B]生成arc这一步，可用circle的实体表，然后替换，删除部分不要的信息，这样能更方便保持circle的其它属性，如颜色。
你这样处理，准确的表述是“断开到当前层". [/B]

这个程序仅是写交点断开时的一个测试片断，没有考虑其他属性。发此主题的用意不在代码本身，完整的将在另外一个帖子内给出。

jx2008 · 发表于 2006-11-23 00:56:53

程序运行起来很慢，速度太慢了，不好啊

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

[原创]：交点断开------圆断开

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

相关帖子