[LISP程序]：本人的将spline等分为n个弧的lisp源代码。

yousuika

为了感谢大家的帮忙，今后我会不断的提供一些自己的程序。

2. 
   
3. 
   
4. (defun c:splinetocircle        (/ ss1 n i cl ss2 ss ed j j0)
   
5.   (setvar "cmdecho" 0)
   
6.   (command "undo" "group")
   
7.   (setq os (getvar "osmode"))
   
8.   (setq cl (getvar "clayer"))
   
9.   (setvar "osmode" 0)
   
10. 
    
11.   (if (setq ent (entsel "\nPlease pick the spline: "))
    
12.     (progn                                ;progn1
    
13.       (command "layer" "m" "spldivide" "c" "1" "" "")
    
14. 
    
15.       (setq ed (entget (car ent)))
    
16.       (setq ss1 (ssadd))
    
17.       (ssadd (car ent) ss1)
    
18. 
    
19.       (if (= (cdr (nth 1 ed))
    
20.              "SPLINE"
    
21.           )
    
22.         (progn
    
23.           (initget (+ 1 2 4))
    
24.           (setq        numPt
    
25.                  (getint
    
26.                    "\nPlease specify the accuracy of conversion.(1~): "
    
27.                  )
    
28.           )
    
29. 
    
30.           (setq        ptSt  (cdr (assoc 11 ed))
    
31.                 ptEnd (cdr (assoc 11 (reverse ed)))
    
32.           )
    
33. 
    
34.           (command "layer" "s" "spldivide" "")
    
35.           (command "divide" ss1 (* 2 numPt))
    
36.           (setq ss2 (ssget "X" '((8 . "spldivide"))))
    
37.           (command "layer" "s" cl "")
    
38. 
    
39.           (setq        j   0
    
40.                 pt3 ptEnd
    
41.           )
    
42. 
    
43.           (repeat numPt
    
44.             (setq pt2 (val1 10 ss2 j))
    
45. 
    
46.             (if        (/= numPt (/ (+ j 2) 2))
    
47.               (setq pt1 (val1 10 ss2 (+ 1 j)))
    
48.               (setq pt1 ptSt)
    
49.             )
    
50. 
    
51.             (command "arc" pt1 pt2 pt3)
    
52.             (setq pt3 pt1)
    
53.             (setq j (+ 2 j))
    
54.           )
    
55. 
    
56.           (command ".erase" ss2 "")
    
57.           (command ".erase" ss1 "")
    
58.           (command "layer" "s" cl "")
    
59. 
    
60.           (command "purge" "la" "" "n")
    
61.           (princ "\nThe conversion end was done. ")
    
62.         )
    
63.         (alert "Selected entity was not a spline!!")
    
64.       )
    
65.       ;;if spline
    
66.     )
    
67.     (alert "Nothing selected!!")
    
68.   )
    
69.   ;;if
    
70. 
    
71.   (setvar "osmode" os)
    
72.   (setvar "clayer" cl)
    
73.   (command "undo" "end")
    
74.   (princ)
    
75. 
    
76. )
    
77. (defun val1 (n ss index)
    
78.   (cdr (assoc n (entget (ssname ss index))))
    
79. )

<br /> <br /> (defun c:splinetocircle        (/ ss1 n i cl ss2 ss ed j j0)<br />   (setvar "cmdecho" 0)<br />   (command "undo" "group")<br />   (setq os (getvar "osmode"))<br />   (setq cl (getvar "clayer"))<br />   (setvar "osmode" 0)<br /> <br />   (if (setq ent (entsel "\nPlease pick the spline: "))<br />     (progn                                ;progn1<br />       (command "layer" "m" "spldivide" "c" "1" "" "")<br /> <br />       (setq ed (entget (car ent)))<br />       (setq ss1 (ssadd))<br />       (ssadd (car ent) ss1)<br /> <br />       (if (= (cdr (nth 1 ed))<br />              "SPLINE"<br />           )<br />         (progn<br />           (initget (+ 1 2 4))<br />           (setq        numPt<br />                  (getint<br />                    "\nPlease specify the accuracy of conversion.(1~): "<br />                  )<br />           )<br /> <br />           (setq        ptSt  (cdr (assoc 11 ed))<br />                 ptEnd (cdr (assoc 11 (reverse ed)))<br />           )<br /> <br />           (command "layer" "s" "spldivide" "")<br />           (command "divide" ss1 (* 2 numPt))<br />           (setq ss2 (ssget "X" '((8 . "spldivide"))))<br />           (command "layer" "s" cl "")<br /> <br />           (setq        j   0<br />                 pt3 ptEnd<br />           )<br /> <br />           (repeat numPt<br />             (setq pt2 (val1 10 ss2 j))<br /> <br />             (if        (/= numPt (/ (+ j 2) 2))<br />               (setq pt1 (val1 10 ss2 (+ 1 j)))<br />               (setq pt1 ptSt)<br />             )<br /> <br />             (command "arc" pt1 pt2 pt3)<br />             (setq pt3 pt1)<br />             (setq j (+ 2 j))<br />           )<br /> <br />           (command ".erase" ss2 "")<br />           (command ".erase" ss1 "")<br />           (command "layer" "s" cl "")<br /> <br />           (command "purge" "la" "" "n")<br />           (princ "\nThe conversion end was done. ")<br />         )<br />         (alert "Selected entity was not a spline!!")<br />       )<br />       ;;if spline <br />     )<br />     (alert "Nothing selected!!")<br />   )<br />   ;;if<br /> <br />   (setvar "osmode" os)<br />   (setvar "clayer" cl)<br />   (command "undo" "end")<br />   (princ)<br /> <br /> )<br /> (defun val1 (n ss index)<br />   (cdr (assoc n (entget (ssname ss index))))<br /> )

XDSoft

谢谢 yousuika   朋友，希望其他朋友也能把自己平时写的工具提供到论坛来，一个是让大家画图提高效率，另外也是大家互相学习编程经验的最好方式。

梦断江南

以后有完整的，经过调试和实践检验的程序，请发一份到程序库版

梦断江南

另一个思路：
用vlisp得线段长度，求1/n长度，按长度逐个取线段上的点，在点处打断实体。
大家 按这个思路写一个程序吧。或者你有其它思路也可以说说or贴出程序

LUCAS

这种类似的方法很久前我就用在画电线了 。

yousuika

最初由 梦断江南 发布
[B]另一个思路：
用vlisp得线段长度，求1/n长度，按长度逐个取线段上的点，在点处打断实体。
大家 按这个思路写一个程序吧。或者你有其它思路也可以说说or贴出程序 [/B]

这种方法，我用ARX做了。

lcl2094_cn

我写了一段等分样条曲线的程序。以下就是源码，当然，用于实际还需要完善一下。还有：我不知道这样等分有什么实际用途：

2. 
   
3. (defun c:sp( / so cmde ssa ssb numpt)
   
4.    (setq os (getvar "osmode"))
   
5.    (setq cmde (getvar "cmdecho"))
   
6.    (setvar "osmode" 0)
   
7.    (setvar "cmdecho" 0)
   
8.    (setq ssa (entsel "请选择样条曲线："))
   
9.    (setq numpt (getint "请输入等分数："))
   
10.    (command "divide" ssa numpt "")
    
11.    (setq ssb (ssget "p"))
    
12.    (setq numpt (1- numpt))
    
13.    (repeat numpt
    
14.         (setq numpt (1- numpt))
    
15.         (setq pt (cdr (assoc '10 (entget (ssname ssb numpt)))))
    
16.         (command "break" pt "f" pt pt "")
    
17.    )
    
18.    (command "erase" ssb "")
    
19.    (setvar "osmode" os)
    
20.    (setvar "cmdecho" cmde)
    
21.    (princ)
    
22. )

<br /> (defun c:sp( / so cmde ssa ssb numpt)<br />    (setq os (getvar "osmode"))<br />    (setq cmde (getvar "cmdecho"))<br />    (setvar "osmode" 0)<br />    (setvar "cmdecho" 0)<br />    (setq ssa (entsel "请选择样条曲线："))<br />    (setq numpt (getint "请输入等分数："))<br />    (command "divide" ssa numpt "")<br />    (setq ssb (ssget "p"))<br />    (setq numpt (1- numpt))<br />    (repeat numpt<br />         (setq numpt (1- numpt))<br />         (setq pt (cdr (assoc '10 (entget (ssname ssb numpt)))))<br />         (command "break" pt "f" pt pt "")<br />    )<br />    (command "erase" ssb "")<br />    (setvar "osmode" os)<br />    (setvar "cmdecho" cmde)<br />    (princ)<br /> )