给大家写了一个点表沿着曲线（或点表）排序的函数(5.30,11点18分更新)

Lispboy · 发表于 2013-5-30 00:56:32

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

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

×

XDRX_API里面有个排序函数很有用，就用LISP模仿写了一个。

QQ截图20130530010300.png

排序对写程序很重要，这个函数可以把一个点表沿着图中的曲线实体的方向排序，也可以沿着另外一个点表（一些点构成PLINE）排序。具体应用很多要用到。

测试命令TT

(defun c:TT ( / a b e ed i len p10 pts ss x)
(if (and
(progn
(princ "\n选取要沿线排序的文字<退出>:")
(setq ss (ssget '((0 . "TEXT"))))
)
(setq e (car (entsel "\n拾取曲线<退出>:")))
)
(progn
(setq i -1
len (sslength ss)
)
(repeat len
(setq e1 (ssname ss (setq i (1+ i)))
ed (entget e1)
p10 (cdr (assoc 10 ed))
pts (cons p10 pts)
)
)
(setq a (Pnts-Sort-Cruve pts e)
b (mapcar
'(lambda (x)
(list (car x) (- (cadr x) 50))
)
a
)
)
(command "text" (car b) "25" "" "1")
(command "text" (cadr b) "25" "" "2")
(command "text" (caddr b) "25" "" "3")
)
)
(princ)
)

(defun c:TT ( / a b e ed i len p10 pts ss x) 
  (if (and 
        (progn 
          (princ "\n选取要沿线排序的文字<退出>:") 
          (setq ss (ssget '((0 . "TEXT")))) 
        ) 
        (setq e (car (entsel "\n拾取曲线<退出>:"))) 
      ) 
    (progn 
      (setq i -1 
            len (sslength ss) 
      ) 
      (repeat len 
        (setq e1 (ssname ss (setq i (1+ i))) 
              ed (entget e1) 
              p10 (cdr (assoc 10 ed)) 
              pts (cons p10 pts) 
        ) 
      ) 
      (setq a (Pnts-Sort-Cruve pts e) 
            b (mapcar 
                '(lambda (x) 
                   (list (car x) (- (cadr x) 50)) 
                 ) 
                a 
              ) 
      ) 
      (command "text" (car b) "25" "" "1") 
      (command "text" (cadr b) "25" "" "2") 
      (command "text" (caddr b) "25" "" "3") 
    ) 
  ) 
  (princ) 
)

排序函数收下豆 (2013.05.30 11.18分修改)

[sell=20]

(defun Pnts-Sort-Cruve (pts e / acaddocument acadobject e1 mspace obj objname x y)
(vl-load-com)
(defun AddPline (space lst / x)
(if (> (length lst) 2)
(vlax-invoke space 'AddLightWeightPolyline (apply
'append
(mapcar
'(lambda (x)
(list (float (car x)) ; _此处应为Double, INT会Fail
(float (cadr x))
)
)
lst
)
)
)
(progn
(vla-AddXLine space (vlax-3d-point (car lst))(vlax-3d-point (cadr lst)))
)
)
)
(cond
((and
(= (type e) 'ENAME)
(setq objname (cdr (assoc 0 (entget e))))
(wcmatch (strcase objname) "*LINE,*CIRCLE,*ARC,*ELLIPSE")
)
(setq pts1 (mapcar
'cdr
(vl-sort (mapcar
'(lambda (x)
(cons (vlax-curve-getParamAtPoint e (vlax-curve-getClosestPointTo e x t)) x)
)
pts
) '(lambda (x y)
(< (car x) (car y))
)
)
)
)
)
((and (= (type e) 'LIST)
(> (length e) 1)
)
(setq AcadObject (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument AcadObject)
mSpace (vla-get-ModelSpace AcadDocument)
)
(addpline mspace e)
(vlax-release-object mSpace)
(vlax-release-object AcadDocument)
(vlax-release-object AcadObject)
(setq e1 (entlast))
(setq pts1 (Pnts-Sort-Cruve pts e1))
(entdel e1)
)
)
pts1
)

(defun Pnts-Sort-Cruve (pts e / acaddocument acadobject e1 mspace  obj objname x y) 
  (vl-load-com) 
  (defun AddPline (space lst / x) 
 
    (if (> (length lst) 2) 
       (vlax-invoke space  'AddLightWeightPolyline (apply 
                                                 'append 
                                                 (mapcar 
                                                   '(lambda (x) 
                                                      (list (float (car x)) ; _此处应为Double, INT会Fail 
                                                            (float (cadr x)) 
                                                      ) 
                                                    ) 
                                                   lst 
                                                 ) 
                                               ) 
        ) 
        (progn 
          (vla-AddXLine space (vlax-3d-point (car lst))(vlax-3d-point (cadr lst))) 
        ) 
    ) 
  ) 
  (cond 
    ((and 
       (= (type e) 'ENAME) 
       (setq objname (cdr (assoc 0 (entget e)))) 
       (wcmatch (strcase objname) "*LINE,*CIRCLE,*ARC,*ELLIPSE") 
     ) 
      (setq pts1 (mapcar 
                   'cdr 
                   (vl-sort (mapcar 
                              '(lambda (x) 
                                 (cons (vlax-curve-getParamAtPoint e (vlax-curve-getClosestPointTo e x t)) x) 
                               ) 
                              pts 
                            ) '(lambda (x y) 
                                 (< (car x) (car y)) 
                               ) 
                   ) 
                 ) 
      ) 
    ) 
    ((and (= (type e) 'LIST) 
          (> (length e) 1) 
     ) 
      (setq AcadObject (vlax-get-acad-object) 
            AcadDocument (vla-get-ActiveDocument AcadObject) 
            mSpace (vla-get-ModelSpace AcadDocument) 
      ) 
      (addpline mspace e) 
      (vlax-release-object mSpace) 
      (vlax-release-object AcadDocument) 
      (vlax-release-object AcadObject) 
      (setq e1 (entlast)) 
      (setq pts1 (Pnts-Sort-Cruve pts e1)) 
      (entdel e1) 
    ) 
  ) 
  pts1 
)

[/sell]

GTJ116600 · 发表于 2013-5-30 04:33:18

呵呵，好贵呀。要20豆。{:soso_e109:}
没办法，看完介绍后，太心动，太好奇了。看看吧

eachy · 发表于 2013-5-30 05:25:21

http://search.xdcad.net/f/discuz ... p;searchsubmit=true

GTJ116600 · 发表于 2013-5-30 05:38:37

呵呵，研究这个问题的人很多呀。好。一定跟各位高手好好学习学习。

dwg001 · 发表于 2013-5-30 08:07:53

拾取图像，取其某一属性，对某些选集排序。有新意，赞！

QiaoCheng · 发表于 2013-5-30 08:49:03

建议生成的文字高度最好与原文字高度一致

Lispboy · 发表于 2013-5-30 09:07:39

QiaoCheng 发表于 2013-5-30 08:49
建议生成的文字高度最好与原文字高度一致

那仅仅是个演示，也不是要对文字做什么，只是告诉大家把文字的10点给排序了。

牢固 · 发表于 2013-5-30 09:14:06

本帖最后由牢固于 2013-5-30 09:24 编辑

这个函数还是有有一个Bug没有解决，就是当有排序的点在曲线端点之外时，这部分在曲线端点之外的点就无法排序了！

/db_自贡黄明儒_ · 发表于 2013-5-30 09:15:10

基本思路是什么?各图元组码10到曲线垂点,然后以垂点离曲线起点来排序?

牢固 · 发表于 2013-5-30 09:23:13

/db_自贡黄明儒_ 发表于 2013-5-30 09:15
基本思路是什么?各图元组码10到曲线垂点,然后以垂点离曲线起点来排序?

原理是计算点投影到曲线上点的参数进行排序！

Lispboy · 发表于 2013-5-30 09:55:04

牢固发表于 2013-5-30 09:14
这个函数还是有有一个Bug没有解决，就是当有排序的点在曲线端点之外时，这部分在曲线端点之外的点就无法排 ...

是的，G版，虽然程序里面求getCloestPoint时候使用了扩展曲线T参数，但由于一些曲线无法EXTEND，所以对于SPLINE,POLYLINE等有你说的问题，但对LINE,ARC可以

这个函数设计的初衷不是为了在那些复杂的曲线上排点，主要是希望能沿着一条LINE就行了，因为很多操作应用基于一条LINE就够了，比如逐点的尺寸标注，用户任意选点，然后沿着起点和终点这条线，把这些点排序，然后标注。

另外，函数是为程序服务的，所以对于具体应用，用户应该构造足够把这些点包含住的点表。

你提醒了我，我考虑加上点表是2点的时候，不用PLINE排，用LINE，这样就可以扩展LINE了。

牢固 · 发表于 2013-5-30 10:17:25

本帖最后由牢固于 2013-5-30 10:24 编辑

Lispboy 发表于 2013-5-30 09:55
是的，G版，虽然程序里面求getCloestPoint时候使用了扩展曲线T参数，但由于一些曲线无法EXTEND，所以对于 ...

getCloestPoint求出扩展曲线上的点没有用，因为这些点不在曲线上，getpointatparam得到的参数为nil,所以计算点时扩展是没有用的，当在曲线两头都有点时，这样的排序结果根本就是错误的！
我想排序之前还是要对排序曲线进行判断一下，
比如：1、曲线为直线，当排序的点有在直线外，可以构造Xline进行排序
      2、曲线为圆弧、开口椭圆，可以构造圆、封闭椭圆进行排序
      3、PLine,spline直接让它封闭或者延伸到排序点表构成的包围框边界后再排序

Lispboy · 发表于 2013-5-30 11:27:39

牢固发表于 2013-5-30 10:17
getCloestPoint求出扩展曲线上的点没有用，因为这些点不在曲线上，getpointatparam得到的参数为nil,所以 ...

谢谢G版建议，程序已经修改，加入了参照点表是2点的时候构造XLINE进行排序，其实，这个是我这个程序中最想要的。

下载过的朋友请重新下载。

2、3 回复：

由于函数设计的初衷是给LISP构造排序点表，所以主要的参数还是点表，对于边界扩展未知的如PLINE,SPLINE等还是不要硬延长了吧，因为即使封闭他们，也可能在排序点的内部，也没有结果。

如果用点的最大边界，PLINE,SPLINE实体未必能扩展到边界上。

QiaoCheng · 发表于 2013-5-31 07:11:23

嗯，加入构造XLINE进行排序会更好用，多谢G版提供思路

maiqi816 · 发表于 2013-5-31 18:48:04

好的转播一下动动

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

[原创] 给大家写了一个点表沿着曲线（或点表）排序的函数(5.30,11点18分更新)

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

评分

本帖被以下淘专辑推荐: