求一个将多段线等距打断的lisp？或者别的命令

去去无回

请问有没有可以将不等距的多段线按照自己定义的距离打断的lisp，
我之前是把多段线拟合成样条曲线，然后在用常青藤按照一个距离（一般是20m）将样条曲线转换为多段线，但是转化后的多段线与之前的多段线拟合的不是很好，所以想找一个可以将多段线等距离打断的lsp或者别的可以实现的方法。谢谢

ketxu

highflybir 发表于 2016-3-29 22:16
以下是我的理解：

Thank you ^^

ludaweb

你的要求不是很容易理解，最好能附个图。

去去无回

ludaweb 发表于 2016-3-28 21:59
你的要求不是很容易理解，最好能附个图。

好的，谢谢

ludaweb

给你发个链接吧
http://www.lee-mac.com/segmentcurve.html

Gu_xl

1. (defun c:tt (/ *error* os cmd e d len pt) (vl-load-com)
   
2.   (defun *error* (s)
   
3.     (setvar 'osmode os)
   
4.     (setvar 'cmdecho cmd)
   
5.     (princ s)
   
6.   )
   
7.   (setq os (getvar 'osmode))
   
8.   (setvar 'osmode 0)
   
9.   (setq cmd (getvar 'cmdecho))
   
10.   (setvar 'cmdecho 0)
    
11.   (if (and
    
12.         (setq e (car (entsel "\nSelect a Curve:")))
    
13.         (setq d (getdist "\nBreak Dist："))
    
14.       )
    
15.     (progn
    
16.       (command "_zoom" "o" e "")
    
17.       (while
    
18.         (progn
    
19.           (setq        len
    
20.                  (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
    
21.           )
    
22.           (< d len)
    
23.         )
    
24.          (setq pt (trans (vlax-curve-getPointAtDist e d) 0 1))
    
25.          (command "_break" (list e pt) "_F" pt "@")
    
26.          (setq e (entlast))
    
27.       )
    
28.       (command "_zoom" "_P")
    
29.     )
    
30.   )
    
31.   (setvar 'osmode os)
    
32.   (setvar 'cmdecho cmd)
    
33.   (princ)
    
34. )

(defun c:tt (/ *error* os cmd e d len pt) (vl-load-com)<br />   (defun *error* (s)<br />     (setvar 'osmode os)<br />     (setvar 'cmdecho cmd)<br />     (princ s)<br />   )<br />   (setq os (getvar 'osmode))<br />   (setvar 'osmode 0)<br />   (setq cmd (getvar 'cmdecho))<br />   (setvar 'cmdecho 0)<br />   (if (and<br />         (setq e (car (entsel "\nSelect a Curve:")))<br />         (setq d (getdist "\nBreak Dist："))<br />       )<br />     (progn<br />       (command "_zoom" "o" e "")<br />       (while<br />         (progn<br />           (setq        len<br />                  (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))<br />           )<br />           (< d len)<br />         )<br />          (setq pt (trans (vlax-curve-getPointAtDist e d) 0 1))<br />          (command "_break" (list e pt) "_F" pt "@")<br />          (setq e (entlast))<br />       )<br />       (command "_zoom" "_P")<br />     )<br />   )<br />   (setvar 'osmode os)<br />   (setvar 'cmdecho cmd)<br />   (princ)<br /> )

Gu_xl

加载XLRX_API方法：

1. (defun c:tt1 (/ e d len l pts)
   
2.   (if (and
   
3.         (setq e (car (entsel "\nSelect a Curve:")))
   
4.         (setq d (getdist "\nBreak Dist："))
   
5.       )
   
6.     (progn
   
7.       (setq len
   
8.              (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
   
9.       )
   
10.       (setq l d)
    
11.       (while (< l len)
    
12.         (setq pts (cons (vlax-curve-getPointAtDist e l) pts)
    
13.               l          (+ l d)
    
14.         )
    
15.       )
    
16.       (XLRX-Curve-Split e pts t)
    
17.     )
    
18.   )
    
19.   (princ)
    
20. )

(defun c:tt1 (/ e d len l pts)<br />   (if (and<br />         (setq e (car (entsel "\nSelect a Curve:")))<br />         (setq d (getdist "\nBreak Dist："))<br />       )<br />     (progn<br />       (setq len<br />              (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))<br />       )<br />       (setq l d)<br />       (while (< l len)<br />         (setq pts (cons (vlax-curve-getPointAtDist e l) pts)<br />               l          (+ l d)<br />         )<br />       )<br />       (XLRX-Curve-Split e pts t)<br />     )<br />   )<br />   (princ)<br /> )

去去无回

Gu_xl 发表于 2016-3-29 16:54
加载XLRX_API方法：

冒昧的问下，这个怎么使用呢？是复制到txt然后把后缀改为lsp，加载使用么？

去去无回

Gu_xl 发表于 2016-3-29 16:54
加载XLRX_API方法：

会用了，谢谢,太给力了

highflybir

以下是我的理解：

1. (defun divide_poly (e d / a l n o p s x)
   
2.   ;(setq l (vla-get-length obj))
   
3.   (setq l (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
   
4.   (setq o (vlax-ename->vla-object e))
   
5.   (setq x 0)
   
6.   (setq l (- l 1e-8))
   
7.   (while (< x l)
   
8.     (setq p (vlax-curve-getpointatdist e x))
   
9.     (setq p (trans p 0 e))
   
10.     (setq s (cons (car p) s))
    
11.     (setq s (cons (cadr p) s))
    
12.     (setq x (+ x d))
    
13.   )
    
14.   (if (not (vlax-curve-isClosed e))
    
15.     (setq p (vlax-curve-getendpoint e)
    
16.       p (trans p 0 e)
    
17.       s (cons (car p) s)
    
18.       s (cons (cadr p) s)
    
19.     )
    
20.   )
    
21.   (setq s (reverse s))
    
22. 
    
23.   (setq n (cons 0 (1- (length s))))
    
24.   (setq a (vlax-make-safearray vlax-vbDouble n))         
    
25.   (vlax-make-variant (vlax-safearray-fill a s))
    
26.   
    
27.   (vla-put-coordinates o a)
    
28. )
    
29. 
    
30. (defun c:tt(/ d sel i e)
    
31.   (initget 7)
    
32.   (setq d (getdist "\n等分距离:"))
    
33.   (if (setq sel (ssget '((0 . "LWPOLYLINE"))))
    
34.     (progn
    
35.       (setq i 0)
    
36.       (repeat (sslength sel)
    
37.     (setq e (ssname sel i))
    
38.     (divide_poly e d)
    
39.     (setq i (1+ i))
    
40.       )
    
41.     )
    
42.   )
    
43. )

(defun divide_poly (e d / a l n o p s x)<br />   ;(setq l (vla-get-length obj))<br />   (setq l (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))<br />   (setq o (vlax-ename->vla-object e))<br />   (setq x 0)<br />   (setq l (- l 1e-8))<br />   (while (< x l)<br />     (setq p (vlax-curve-getpointatdist e x))<br />     (setq p (trans p 0 e))<br />     (setq s (cons (car p) s))<br />     (setq s (cons (cadr p) s))<br />     (setq x (+ x d))<br />   )<br />   (if (not (vlax-curve-isClosed e))<br />     (setq p (vlax-curve-getendpoint e)<br />       p (trans p 0 e)<br />       s (cons (car p) s)<br />       s (cons (cadr p) s)<br />     )<br />   )<br />   (setq s (reverse s))<br /> <br />   (setq n (cons 0 (1- (length s))))<br />   (setq a (vlax-make-safearray vlax-vbDouble n))         <br />   (vlax-make-variant (vlax-safearray-fill a s))<br />   <br />   (vla-put-coordinates o a)<br /> )<br /> <br /> (defun c:tt(/ d sel i e)<br />   (initget 7)<br />   (setq d (getdist "\n等分距离:"))<br />   (if (setq sel (ssget '((0 . "LWPOLYLINE"))))<br />     (progn<br />       (setq i 0)<br />       (repeat (sslength sel)<br />     (setq e (ssname sel i))<br />     (divide_poly e d)<br />     (setq i (1+ i))<br />       )<br />     )<br />   )<br /> )

去去无回

highflybir 发表于 2016-3-29 22:16
以下是我的理解：

很好，很强大，谢谢