将排序进行到低(也适合倾斜对象)

/db_自贡黄明儒_ · 发表于 2014-11-15 13:34:43

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

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

×

本帖最后由 /db_自贡黄明儒_ 于 2014-11-15 16:25 编辑

;;[功能] 将排序进行到低(也适合倾斜对象)
;;MinAreaRectangle Graham-scan 见http://bbs.mjtd.com/thread-81308-1-1.html By highflybir
;;ssPts: 1 选择集，返回图元列表
;; 2 点表(1到n维 1维时key只能是x或X)，返回点表
;; 3 图元列表，返回图元列表
;; 4 字符列表或者数值列表
;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先，小y表示从小到大(注:二维点时，不能有z)
;;FUZZ: 允许误差
;;注:点表可以1到n维混合,Key长度不大于点的最小维数。
;;示例1 (HH:SortEndByPt (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
;;示例2 (HH:SortEndByPt (list '(2 3) '(2 4) '(3 5)) "Yx" 0.5);返回((3 5) (2 4) (2 3))
;;示例3 (HH:SortEndByPt '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5)
;;示例4 (HH:SortEndByPt (list "DF" "ZX" "A" "DD" "A") "X" 1)=>("ZX" "DF" "DD" "A" "A")
;;示例5 (HH:SortEndByPt (list 5 8 5.0 9 5) "X" 1)=>(9 8 5 5.0 5)
;;自贡黄明儒 2014年11月15日
(defun HH:SortEndByPt (ssPts KEY FUZZ / AN FUN LST P P1 P2 PB PT PTS SSPTS)
;;1 点列表排序
(defun sortpts (PTS FUN xyz FUZZ)
(vl-sort pts
'(lambda (a b)
(if (not (equal (xyz a) (xyz b) fuzz))
(fun (xyz a) (xyz b))
)
)
)
)
;;2 排序先后
(defun sortpts1 (PTS KEY FUZZ)
(foreach xyz (reverse (vl-string->list Key))
(cond ((< xyz 100)
(setq fun >)
(setq xyz (nth (- xyz 88) (list car cadr caddr)))
)
(T
(setq fun <)
(setq xyz (nth (- xyz 120) (list car cadr caddr)))
)
)
(setq Pts (sortpts Pts fun xyz fuzz))
)
)
;;3 [功能] 点表旋转
(defun HH:Sort-rotate (pts pb an / P PT)
(mapcar '(lambda (p)
(setq pt (list (car p) (cadr p)))
(setq pt (polar pb (+ (angle pt pb) an) (distance pt pb)))
(list (car pt) (cadr pt) (caddr p) (cadddr p))
)
pts
)
)
;;4 [功能] 排序用选择集(图元列表)取点函数
(defun HH:SortEndByPt-SS (ss / E EN GRAH N P SORT)
(cond
((= (type ssPts) 'PICKSET)
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq en (entget e))
(cond ((wcmatch (cdr (assoc 0 en)) "POINT,ARC,CIRCLE,ELLIPSE")
(setq p (cdr (assoc 10 en)))
)
(T (setq p (MiddleCenPoint e)))
)
(setq Sort (cons (append p (list e)) Sort)) ;排序
(setq Grah (cons p Grah)) ;扫描
)
)
(T
(foreach n ss
(setq en (entget n))
(cond ((wcmatch (cdr (assoc 0 en)) "POINT,ARC,CIRCLE,ELLIPSE")
(setq p (cdr (assoc 10 en)))
)
(T (setq p (MiddleCenPoint n)))
)
(setq Sort (cons (append p (list n)) Sort)) ;排序
(setq Grah (cons p Grah)) ;扫描
)
)
)
(list Grah Sort)
)
;;5 本程序主程序
(cond
((or (= (type ssPts) 'PICKSET)
(and (Listp ssPts) (= (type (car ssPts)) 'ENAME))
)
(setq pts (HH:SortEndByPt-SS ssPts))
(setq lst (cadr pts))
(setq pts (car pts))
(setq pts (car (MinAreaRectangle (Graham-scan pts)))) ;4点
;;如果前2点（最下2点）Y坐标误差>fuzz,则旋转对象
(setq p1 (car pts))
(setq p2 (cadddr pts))
(cond ((> (abs (- (cadr p1) (cadr p2))) FUZZ)
(setq lst (HH:Sort-rotate lst p1 (- (angle p1 p2))))
)
)
(mapcar 'cadddr (sortpts1 lst KEY FUZZ))
)
((Listp ssPts)
(cond
;;是否为点
((and (vl-consp (car ssPts))
(null (vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point (car ssPts))))
)
(setq pts (car (MinAreaRectangle (Graham-scan ssPts)))) ;4点
(setq p1 (car pts))
(setq p2 (cadr pts))
(cond ((equal (abs (- (cadr p1) (cadr p2))) FUZZ)
(setq lst (HH:Sort-rotate ssPts p1 (angle p1 p2)))
)
(T (setq lst ssPts))
)
(sortpts1 lst KEY FUZZ)
)
(T
(cond ((wcmatch key "X,Y,Z") (vl-sort ssPts '>))
((wcmatch key "x,y,z") (vl-sort ssPts '<))
)
)
)
)
)
)
;;功能:获取对象正中点
(defun MiddleCenPoint (e / P1 P2 PLIST X)
(cond ((= (type e) 'ename) (setq e (vlax-ename->vla-object e))))
(vla-getboundingbox e 'p1 'p2)
(setq p1 (vlax-safearray->list p1))
(setq p2 (vlax-safearray->list p2))
(mapcar '(lambda (X Y) (* (+ X Y) 0.5)) P1 P2)
)

;;[功能] 将排序进行到低(也适合倾斜对象) 
;;MinAreaRectangle Graham-scan 见http://bbs.mjtd.com/thread-81308-1-1.html By highflybir 
;;ssPts: 1 选择集，返回图元列表 
;;           2 点表(1到n维 1维时key只能是x或X)，返回点表 
;;          3 图元列表，返回图元列表 
;;       4 字符列表或者数值列表 
;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先，小y表示从小到大(注:二维点时，不能有z) 
;;FUZZ: 允许误差 
;;注:点表可以1到n维混合,Key长度不大于点的最小维数。 
;;示例1 (HH:SortEndByPt (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>) 
;;示例2 (HH:SortEndByPt (list '(2 3) '(2 4) '(3 5)) "Yx" 0.5);返回((3 5) (2 4) (2 3)) 
;;示例3 (HH:SortEndByPt '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5) 
;;示例4 (HH:SortEndByPt (list "DF" "ZX" "A" "DD" "A") "X" 1)=>("ZX" "DF" "DD" "A" "A") 
;;示例5 (HH:SortEndByPt (list 5 8 5.0 9 5) "X" 1)=>(9 8 5 5.0 5) 
;;自贡黄明儒 2014年11月15日 
(defun HH:SortEndByPt (ssPts KEY FUZZ / AN FUN LST P P1 P2 PB PT PTS SSPTS) 
  ;;1 点列表排序 
  (defun sortpts (PTS FUN xyz FUZZ) 
    (vl-sort pts 
             '(lambda (a b) 
                (if (not (equal (xyz a) (xyz b) fuzz)) 
                  (fun (xyz a) (xyz b)) 
                ) 
              ) 
    ) 
  ) 
  ;;2 排序先后 
  (defun sortpts1 (PTS KEY FUZZ) 
    (foreach xyz (reverse (vl-string->list Key)) 
      (cond ((< xyz 100) 
             (setq fun >) 
             (setq xyz (nth (- xyz 88) (list car cadr caddr))) 
            ) 
            (T 
             (setq fun <) 
             (setq xyz (nth (- xyz 120) (list car cadr caddr))) 
            ) 
      ) 
      (setq Pts (sortpts Pts fun xyz fuzz)) 
    ) 
  ) 
  ;;3 [功能] 点表旋转 
  (defun HH:Sort-rotate        (pts pb an / P PT) 
    (mapcar '(lambda (p) 
               (setq pt (list (car p) (cadr p))) 
               (setq pt (polar pb (+ (angle pt pb) an) (distance pt pb))) 
               (list (car pt) (cadr pt) (caddr p) (cadddr p)) 
             ) 
            pts 
    ) 
  ) 
  ;;4 [功能] 排序用选择集(图元列表)取点函数 
  (defun HH:SortEndByPt-SS (ss / E EN GRAH N P SORT) 
    (cond 
      ((= (type ssPts) 'PICKSET) 
       (repeat (setq n (sslength ss)) 
         (setq e (ssname ss (setq n (1- n)))) 
         (setq en (entget e)) 
         (cond ((wcmatch (cdr (assoc 0 en)) "POINT,ARC,CIRCLE,ELLIPSE") 
                (setq p (cdr (assoc 10 en))) 
               ) 
               (T (setq p (MiddleCenPoint e))) 
         ) 
         (setq Sort (cons (append p (list e)) Sort))            ;排序 
         (setq Grah (cons p Grah))                            ;扫描 
       ) 
      ) 
      (T 
       (foreach        n ss 
         (setq en (entget n)) 
         (cond ((wcmatch (cdr (assoc 0 en)) "POINT,ARC,CIRCLE,ELLIPSE") 
                (setq p (cdr (assoc 10 en))) 
               ) 
               (T (setq p (MiddleCenPoint n))) 
         ) 
         (setq Sort (cons (append p (list n)) Sort))            ;排序 
         (setq Grah (cons p Grah))                            ;扫描 
       ) 
      ) 
    ) 
    (list Grah Sort) 
  ) 
  ;;5  本程序主程序 
  (cond 
    ((or (= (type ssPts) 'PICKSET) 
         (and (Listp ssPts) (= (type (car ssPts)) 'ENAME)) 
     ) 
     (setq pts (HH:SortEndByPt-SS ssPts)) 
     (setq lst (cadr pts)) 
     (setq pts (car pts)) 
     (setq pts (car (MinAreaRectangle (Graham-scan pts))))  ;4点      
     ;;如果前2点（最下2点）Y坐标误差>fuzz,则旋转对象 
     (setq p1 (car pts)) 
     (setq p2 (cadddr pts)) 
     (cond ((> (abs (- (cadr p1) (cadr p2))) FUZZ) 
            (setq lst (HH:Sort-rotate lst p1 (- (angle p1 p2)))) 
           ) 
     ) 
     (mapcar 'cadddr (sortpts1 lst KEY FUZZ)) 
    ) 
    ((Listp ssPts) 
     (cond 
       ;;是否为点 
       ((and (vl-consp (car ssPts)) 
             (null (vl-catch-all-error-p (vl-catch-all-apply 'vlax-3d-point (car ssPts)))) 
        ) 
        (setq pts (car (MinAreaRectangle (Graham-scan ssPts)))) ;4点 
        (setq p1 (car pts)) 
        (setq p2 (cadr pts)) 
        (cond ((equal (abs (- (cadr p1) (cadr p2))) FUZZ) 
               (setq lst (HH:Sort-rotate ssPts p1 (angle p1 p2))) 
              ) 
              (T (setq lst ssPts)) 
        ) 
        (sortpts1 lst KEY FUZZ) 
       ) 
       (T 
        (cond ((wcmatch key "X,Y,Z") (vl-sort ssPts '>)) 
              ((wcmatch key "x,y,z") (vl-sort ssPts '<)) 
        ) 
       ) 
     ) 
    ) 
  ) 
) 
;;功能:获取对象正中点 
(defun MiddleCenPoint (e / P1 P2 PLIST X) 
  (cond ((= (type e) 'ename) (setq e (vlax-ename->vla-object e)))) 
  (vla-getboundingbox e 'p1 'p2) 
  (setq p1 (vlax-safearray->list p1)) 
  (setq p2 (vlax-safearray->list p2)) 
  (mapcar '(lambda (X Y) (* (+ X Y) 0.5)) P1 P2) 
)

st788796 · 发表于 2014-11-15 14:23:41

本帖最后由 st788796 于 2014-11-15 14:30 编辑

排序没什么不同，只和点的坐标系有关系，你给何 WCS 一直的坐标就是按 WCS 排，你给倾斜坐标系坐标就按倾斜坐标系排

更通用的是给个 xdir ，所有点转换到这个 xdir 坐标系下排序

/db_自贡黄明儒_ · 发表于 2014-11-15 14:29:53

st788796 发表于 2014-11-15 14:23
排序没什么不同，只和点的坐标系有关系，你给何 WCS 一直的坐标就是按 WCS 排，你给倾斜坐标系坐标就按倾斜 ...

是呀，首先要确定倾斜了多少

newer · 发表于 2014-11-15 14:35:15

/db_自贡黄明儒_ 发表于 2014-11-15 14:29
是呀，首先要确定倾斜了多少

你怎么定倾斜多少呢？

st788796 · 发表于 2014-11-15 14:36:55

/db_自贡黄明儒_ 发表于 2014-11-15 14:29
是呀，首先要确定倾斜了多少

排序只管排序，点转换另外写

(defun pnts:trans (pts xdir)
(mapcar '(lambda (x / p)
(setq p (trans x 0 xdir))
(list (car p) (last p) 0.0)
)
pts
)
)

/db_自贡黄明儒_ · 发表于 2014-11-15 15:14:34

newer 发表于 2014-11-15 14:35
你怎么定倾斜多少呢？

我先用highflybir的程序扫描，获得最小包围矩形，矩形一边的2点如果小于允差，就不旋转各对象。

newer · 发表于 2014-11-15 15:26:03

本帖最后由 newer 于 2014-11-15 15:31 编辑

/db_自贡黄明儒_ 发表于 2014-11-15 15:14
我先用highflybir的程序扫描，获得最小包围矩形，矩形一边的2点如果小于允差，就不旋转各对象。

下面哪一个是你的主方向呢？

QQ截图20141115153130.png

newer · 发表于 2014-11-15 15:36:34

我想这么排

还想这么排

甚至又想这么排

上面每个排法的行列元素都不一样哦，你用最小矩形怎么求？

st788796 · 发表于 2014-11-15 15:51:52

newer 发表于 2014-11-15 15:36
我想这么排

你这是和黄老抬杠了，排自然要有同一特性的{:soso_e100:}

/db_自贡黄明儒_ · 发表于 2014-11-15 15:52:21

newer 发表于 2014-11-15 15:36
我想这么排

这种就不好干了。我只能根据最小包围盒的方向排。

newer · 发表于 2014-11-15 16:09:41

st788796 发表于 2014-11-15 15:51
你这是和黄老抬杠了，排自然要有同一特性的

我是想和黄老师说了，排序不用想那么复杂的，找到最小点，然后想怎么排怎么排，给个X轴就够了，更通用。

newer · 发表于 2014-11-15 16:12:39

/db_自贡黄明儒_ 发表于 2014-11-15 15:52
这种就不好干了。我只能根据最小包围盒的方向排。

一般这种斜排啥的，都是在UCS，PLAN命令画图，然后你在WCS排，在CAD里面，要多利用UCS啊，你的排序和UCS的X轴结合就行了。别想太通用了，什么都让代码去做，太通用反而累了。你的代码多个UCS X轴的参数就更通用了。让用户决定按哪个方向排。因为你给决定的，不一定是用户需要的。

你把那些文字实体啥的想象抽象成点，想在哪个方向排都行。

/db_自贡黄明儒_ · 发表于 2014-11-15 16:18:22

newer 发表于 2014-11-15 16:12
一般这种斜排啥的，都是在UCS，PLAN命令画图，然后你在WCS排，在CAD里面，要多利用UCS啊，你的排序和UCS ...

确实这样好些{:soso_e113:}

434939575 · 发表于 2014-11-16 10:20:50

长见识，厉害;P

freedake · 发表于 2014-11-17 08:12:30

长知识了，厉害！！！

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

[研讨] 将排序进行到低(也适合倾斜对象)

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

点评

点评

点评

点评

点评

点评

点评

点评

评分