点表沿着曲线实体或者另外一个点表组成的多段线排序

Lispboy · 发表于 2013-6-13 20:37:38

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

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

×

[sell=20]

(defun XD::Pnts:SortOnCruve (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 XD::Pnts:SortOnCruve (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]

QiaoCheng · 发表于 2013-6-13 20:41:36

本帖最后由 QiaoCheng 于 2013-6-13 20:45 编辑

咋要20豆？是不是和之前的那个函数一样啊?

Lispboy · 发表于 2013-6-13 20:48:32

QiaoCheng 发表于 2013-6-13 20:41
咋要20豆？是不是和之前的那个函数一样啊?

一样，整理下名字，如果不收豆，对不起那边付费的朋友了。你要下载了，就别下了。

QiaoCheng · 发表于 2013-6-13 20:50:37

Lispboy 发表于 2013-6-13 20:48
一样，整理下名字，如果不收豆，对不起那边付费的朋友了。你要下载了，就别下了。

没关系，40、60个都也没关系:lol

q3_2006 · 发表于 2013-6-17 08:47:34

有钱就是不一样，先收藏，要用再买！

st788796 · 发表于 2014-11-30 13:10:02

写个借用 Ge 实体的方法

(defun XD::Pnts:SortOnCurve (pts e func / curve)
(cond
((and (eq (type e) 'ENAME)
(= (xdrx_getpropertyvalue e "MyParent") "AcDbCurve")
)
(vl-sort pts
'(lambda (x1 x2)
(apply func
(list (xdrx_curve_getparamatpoint e x1)
(xdrx_curve_getparamatpoint e x2)
)
)
)
)
)
((listp e)
(if (= (length e) 2)
(setq curve (xdge::constructor "kLine3d" (car e) (cadr e)))
(setq curve (xdge::constructor "kPolyline3d" e))
)
(setq pts (vl-sort
pts
'(lambda (x1 x2)
(apply
func
(list
(xdge::getpropertyvalue
curve
"paramOf"
(xdge::getpropertyvalue
(xdge::getpropertyvalue
curve
"getClosestPointTo"
x1
)
"Point"
)
)
(xdge::getpropertyvalue
curve
"paramOf"
(xdge::getpropertyvalue
(xdge::getpropertyvalue
curve
"getClosestPointTo"
x2
)
"Point"
)
)
)
)
)
)
)
(xdge::free)
pts
)
(t pts)
)
)

(defun XD::Pnts:SortOnCurve (pts e func / curve) 
  (cond 
    ((and (eq (type e) 'ENAME) 
          (= (xdrx_getpropertyvalue e "MyParent") "AcDbCurve") 
     ) 
     (vl-sort pts 
              '(lambda (x1 x2) 
                 (apply        func 
                        (list (xdrx_curve_getparamatpoint e x1) 
                              (xdrx_curve_getparamatpoint e x2) 
                        ) 
                 ) 
               ) 
     ) 
    ) 
    ((listp e) 
     (if (= (length e) 2) 
       (setq curve (xdge::constructor "kLine3d" (car e) (cadr e))) 
       (setq curve (xdge::constructor "kPolyline3d" e)) 
     ) 
     (setq pts (vl-sort 
                 pts 
                 '(lambda (x1 x2) 
                    (apply 
                      func 
                      (list 
                        (xdge::getpropertyvalue 
                          curve 
                          "paramOf" 
                          (xdge::getpropertyvalue 
                            (xdge::getpropertyvalue 
                              curve 
                              "getClosestPointTo" 
                              x1 
                            ) 
                            "Point" 
                          ) 
                        ) 
                        (xdge::getpropertyvalue 
                          curve 
                          "paramOf" 
                          (xdge::getpropertyvalue 
                            (xdge::getpropertyvalue 
                              curve 
                              "getClosestPointTo" 
                              x2 
                            ) 
                            "Point" 
                          ) 
                        ) 
                      ) 
                    ) 
                  ) 
               ) 
     ) 
     (xdge::free) 
     pts 
    ) 
    (t pts) 
  ) 
)

newer · 发表于 2014-11-30 13:42:14

st788796 发表于 2014-11-30 13:10
写个借用 Ge 实体的方法

建议，xdrx_free 还是后面跟着参数，只释放本函数内创建的GE实体，因为如果全部释放了，可能造成函数外面的应用出错（万一外面也用GE了，就都给释放了）。

newer · 发表于 2014-11-30 13:43:34

st788796 发表于 2014-11-30 13:10
写个借用 Ge 实体的方法

FUNC 参数怎么用？

st788796 · 发表于 2014-11-30 23:00:21

newer 发表于 2014-11-30 13:43
FUNC 参数怎么用？

func 正向排 '< , 反向排 ‘>
上面写法生成太多的 kPointOnCurve，修改如下

(defun XD::Pnts:SortOnCurve (pts e func / curve npts)
(cond
((and (eq (type e) 'ENAME)
(= (xdrx_getpropertyvalue e "MyParent") "AcDbCurve")
)
(vl-sort pts
'(lambda (x1 x2)
(apply func
(list (xdrx_curve_getparamatpoint e x1)
(xdrx_curve_getparamatpoint e x2)
)
)
)
)
)
((listp e)
(if (= (length e) 2)
(setq curve (xdge::constructor "kLine3d" (car e) (cadr e)))
(setq curve (xdge::constructor "kPolyline3d" e))
)
(setq npts
(mapcar '(lambda (x / gp pam)
(setq gp (xdge::getpropertyvalue
curve
"getClosestPointTo"
x
)
pam (xdge::getpropertyvalue gp "parameter")
)
(xdge::free gp);_即时释放
(list pam x)
)
pts
)
)
(xdge::free curve)
(mapcar 'cadr
(vl-sort npts
'(lambda (x1 x2)
(apply func (list (car x1) (car x2)))
)
)
)
)
(t pts)
)
)

(defun XD::Pnts:SortOnCurve (pts e func / curve npts) 
  (cond 
    ((and (eq (type e) 'ENAME) 
          (= (xdrx_getpropertyvalue e "MyParent") "AcDbCurve") 
     ) 
     (vl-sort pts 
              '(lambda (x1 x2) 
                 (apply        func 
                        (list (xdrx_curve_getparamatpoint e x1) 
                              (xdrx_curve_getparamatpoint e x2) 
                        ) 
                 ) 
               ) 
     ) 
    ) 
    ((listp e) 
     (if (= (length e) 2) 
       (setq curve (xdge::constructor "kLine3d" (car e) (cadr e))) 
       (setq curve (xdge::constructor "kPolyline3d" e)) 
     ) 
     (setq npts 
            (mapcar '(lambda (x / gp pam) 
                       (setq gp         (xdge::getpropertyvalue 
                                   curve 
                                   "getClosestPointTo" 
                                   x 
                                 ) 
                             pam (xdge::getpropertyvalue gp "parameter") 
                       ) 
                       (xdge::free gp);_即时释放 
                       (list pam x) 
                     ) 
                    pts 
            ) 
     ) 
     (xdge::free curve) 
     (mapcar 'cadr 
             (vl-sort npts 
                      '(lambda (x1 x2) 
                         (apply func (list (car x1) (car x2))) 
                       ) 
             ) 
     ) 
    ) 
    (t pts) 
  ) 
)

[/code]

XDSoft · 发表于 2014-11-30 23:34:10

st788796 发表于 2014-11-30 23:00
func 正向排 '< , 反向排 ‘>
上面写法生成太多的 kPointOnCurve，修改如下

加FUNC感觉复杂了吧，需要反的，reverse下结果不就行了，而且排序有一种方向就够了。参数多了，反而分散注意力了。固定下逆时针方向就行了（左下右上方向）

Free-Lancer · 发表于 2014-12-1 08:34:34

既然给了点表，方向自己应该知道，函数就按给定pts方向排

kkt123 · 发表于 2015-2-15 08:55:15

:loveliness:有钱就是不一样:loveliness:

czcxxx_01 · 发表于 2015-9-5 12:36:31

真是好东西，谢谢高手

shaodeng000 · 发表于 2015-10-19 21:43:04

支持。晓东工具箱

shaodeng000 · 发表于 2015-10-19 21:44:12

真是好东西，谢谢高手

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

[点表] 点表沿着曲线实体或者另外一个点表组成的多段线排序

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

点评

点评

点评

点评