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

q3_2006 · 发表于 2013-6-17 07:33:11

好深，看晕了！

rq28 · 发表于 2013-7-12 12:13:18

200 D 才能看一眼:dizzy:

9635luyu · 发表于 2013-11-27 21:01:54

这个函数还是有用的，也许可以用来完成建筑版cad中的LINEWORKTRIM的功能，用来重构点表，重新生成多义线

Lisphk · 发表于 2013-11-27 22:17:30

9635luyu 发表于 2013-11-27 21:01
这个函数还是有用的，也许可以用来完成建筑版cad中的LINEWORKTRIM的功能，用来重构点表，重新生成多义线

LINEWORKTRIM是什么？建筑CAD专有的？

st788796 · 发表于 2013-11-27 22:35:39

现写了一个, 没有测试,看看有什么区别

(defun Pnts:SortOnCurve (pts curve / pams npams tf pts)
(if (= (cdr (assoc 0 (entget curve))) "LINE")
(setq curve
(entmakex (list '(0 . "Line")
'(100 . "AcDbEntity")
'(100 . "AcDbXLine")
(cons 10 (vlax-curve-getstartpoint curve))
(cons 11 (vlax-curve-getendpoint curve))
)
)
tf t
)
)
(setq pams (vl-sort (mapcar '(lambda (x)
(vlax-curve-getparamatpoint
curve
(vlax-curve-getclosestpointto x curve)
)
)
'<
)
)
npams (car pams)
)
(while (setq pams (cdr pams))
(if (equal (car pams) (car npams) 1e-6)
(setq pams (cdr pams))
(setq npams (cons (car pams) npams))
)
)
(setq pts (mapcar '(lambda (x)
(vlax-curve-getpointatparam x curve)
)
(reverse npams)
)
)
(if tf
(entdel curve)
)
pts
)

(defun Pnts:SortOnCurve        (pts curve / pams npams tf pts) 
  (if (= (cdr (assoc 0 (entget curve))) "LINE") 
    (setq curve 
           (entmakex (list '(0 . "Line") 
                           '(100 . "AcDbEntity") 
                           '(100 . "AcDbXLine") 
                           (cons 10 (vlax-curve-getstartpoint curve)) 
                           (cons 11 (vlax-curve-getendpoint curve)) 
                     ) 
           ) 
          tf t 
    ) 
  ) 
  (setq        pams  (vl-sort (mapcar '(lambda        (x) 
                                  (vlax-curve-getparamatpoint 
                                    curve 
                                    (vlax-curve-getclosestpointto x curve) 
                                  ) 
                                ) 
                               '< 
                       ) 
              ) 
        npams (car pams) 
  ) 
  (while (setq pams (cdr pams)) 
    (if        (equal (car pams) (car npams) 1e-6) 
      (setq pams (cdr pams)) 
      (setq npams (cons (car pams) npams)) 
    ) 
  ) 
  (setq        pts (mapcar '(lambda (x) 
                       (vlax-curve-getpointatparam x curve) 
                     ) 
                    (reverse npams) 
            ) 
  ) 
  (if tf 
    (entdel curve) 
  ) 
  pts 
)

maker_lv · 发表于 2013-12-12 15:32:36

赞一个，好东西，下来研究一下

aa-909 · 发表于 2013-12-13 09:10:39

大伙看下这个取点的精华
定距等分点.gif

laiz3000 · 发表于 2015-5-25 21:46:48

好东西要收藏一下

树櫴希德 · 发表于 2016-11-19 10:27:29

200dou 好贵啊

cq_qg68 · 发表于 2016-11-19 20:56:18

确实是很实用的一个程序。

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

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

点评

浏览过的版块