（XD::PolyLine:AngleGroup）多段线角度类型分组

Lispboy · 发表于 2016-10-7 22:47:43

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

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

×

本帖最后由 Lispboy 于 2016-10-7 23:00 编辑

(defun XD::PolyLine:AngleGroup (e / a area b ba bb bc c i ia ib ic node
node1 p pts src tf x y z
)
(if (= "POLYLINE" (car (xdrx_object_classname e)))
(xdrx_polyline_convertfrom e)
)
(xdrx_polyline_compress e)
(setq pts (xdrx_getpropertyvalue e "vertices")
area (apply
'xdrx_points_area
pts
)
src pts
)
(if (minusp area) ; _顺时针为负
(progn
(setq tf (xdrx_curve_reverse e))
(setq pts (xdrx_getpropertyvalue e "vertices"))
)
)
(setq pts (append
pts
(list (car pts) (cadr pts))
)
)
(while (caddr pts) ; _three
(mapcar
'set
'(a b c)
pts
)
(mapcar
'(lambda (x y z)
(set x (xdrx_curve_getparamatpoint e z))
(set y (xdrx_polyline_getbulgeat e (fix (eval x))))
)
'(ia ib ic)
'(ba bb bc)
(list a b c)
)
(cond
((and
(= ba bb 0.) ; _全直线
(> (xdrx_points_area a b c) 0.)
)
(setq node (cons b node))
)
((and
(or
(zerop ba)
(zerop bb)
)
(progn
(setq p (xdrx_curve_getpointatparam e (if (zerop ba)
(/ (+ ib ic) 2.)
(/ (+ ia ib) 2.)
)
)
)
(and
(if (zerop ba)
(minusp (xdrx_point_dist2line p b c))
(minusp (xdrx_point_dist2line p a b))
) ; _ 左侧，圆弧内凹
(> (xdrx_points_area a b c) 0.) ; _且面积为正
)
)
)
(setq node (cons b node))
)
(t
)
)
(setq pts (cdr pts))
)
(if tf
(xdrx_curve_reverse e)
)
(setq node (mapcar
'(lambda (x)
(vl-position x src)
)
node
)
)
(setq tf1 (xdrx_getpropertyvalue e "isclosed"))
(setq node (if tf1
node
(vl-remove (1- (length src)) (vl-remove 0 node))
)
)
(setq node (vl-sort node '(lambda (x y)
(< x y)
)
)
)
(setq i 1)
(repeat (if tf1
(1- (length src))
(- (length src) 2)
)
(if (not (member i node))
(setq node1 (cons i node1))
)
(setq i (1+ i))
)
(list node (reverse node1))
)

(defun XD::PolyLine:AngleGroup (e / a area b ba bb bc c i ia ib ic node 
          node1 p pts src tf x y z 
             ) 
  (if (= "POLYLINE" (car (xdrx_object_classname e))) 
    (xdrx_polyline_convertfrom e) 
  ) 
  (xdrx_polyline_compress e) 
  (setq pts (xdrx_getpropertyvalue e "vertices") 
  area (apply 
         'xdrx_points_area 
         pts 
       ) 
  src pts 
  ) 
  (if (minusp area)           ; _顺时针为负 
    (progn 
      (setq tf (xdrx_curve_reverse e)) 
      (setq pts (xdrx_getpropertyvalue e "vertices")) 
    ) 
  ) 
  (setq pts (append 
        pts 
        (list (car pts) (cadr pts)) 
      ) 
  ) 
  (while (caddr pts)           ; _three 
    (mapcar 
      'set 
      '(a b c) 
      pts 
    ) 
    (mapcar 
      '(lambda (x y z) 
   (set x (xdrx_curve_getparamatpoint e z)) 
   (set y (xdrx_polyline_getbulgeat e (fix (eval x)))) 
       ) 
      '(ia ib ic) 
      '(ba bb bc) 
      (list a b c) 
    ) 
    (cond 
      ((and 
   (= ba bb 0.)           ; _全直线 
   (> (xdrx_points_area a b c) 0.) 
       ) 
  (setq node (cons b node)) 
      ) 
      ((and 
   (or 
     (zerop ba) 
     (zerop bb) 
   ) 
   (progn 
     (setq p (xdrx_curve_getpointatparam e (if (zerop ba) 
               (/ (+ ib ic) 2.) 
               (/ (+ ia ib) 2.) 
             ) 
       ) 
     ) 
     (and 
       (if (zerop ba) 
         (minusp (xdrx_point_dist2line p b c)) 
         (minusp (xdrx_point_dist2line p a b)) 
       )             ; _ 左侧，圆弧内凹 
       (> (xdrx_points_area a b c) 0.) ; _且面积为正 
     ) 
   ) 
       ) 
  (setq node (cons b node)) 
      ) 
      (t 
      ) 
    ) 
    (setq pts (cdr pts)) 
  ) 
  (if tf 
    (xdrx_curve_reverse e) 
  ) 
  (setq node (mapcar 
         '(lambda (x) 
      (vl-position x src) 
    ) 
         node 
       ) 
  ) 
  (setq tf1 (xdrx_getpropertyvalue e "isclosed")) 
  (setq node (if tf1 
         node 
         (vl-remove (1- (length src)) (vl-remove 0 node)) 
       ) 
  ) 
  (setq node (vl-sort node '(lambda (x y) 
            (< x y) 
          ) 
       ) 
  ) 
  (setq i 1) 
  (repeat (if tf1 
      (1- (length src)) 
      (- (length src) 2) 
    ) 
    (if (not (member i node)) 
      (setq node1 (cons i node1)) 
    ) 
    (setq i (1+ i)) 
  ) 
  (list node (reverse node1)) 
)

qqqincccken · 发表于 2016-10-8 00:09:02

谢谢提供,学习一下!!

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

[多段线] （XD::PolyLine:AngleGroup）多段线角度类型分组

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