[求助]鬼魔及路过的高手们，进来看一下

loner

这个lsp是鬼魔大侠编的，在2007下运行已没问题，请问能移植在R14下运行吗
是解决已知两点和弧长，画弧的东东
(defun c:aaa (/ p1 p2 s a l x xx fx flx r c c1 c2 mspace myobj)
(defun N ()
(setq c (- (+ a (* 0.5 pi)) (* x 0.5)))
(setq cen (polar p1 c r))
(setq c1 (+ c pi))
(setq c2 (+ c1 x))
(setq myobj (vla-addarc mspace (vlax-3d-point cen) r c1 c2))
(princ)
)
(setq p1 (getpoint "\n请输入圆弧第一点:"))
(setq p2 (getpoint p1 "\n请输入圆弧第二点:"))
(setq s (getdist p1 "\n请输入弧长："))
(setq a (angle p1 p2))
(setq l (distance p1 p2))
(vl-load-com)
(setq mspace (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
)
(if (<= s l)
(progn
(prompt "您所要画的圆弧并不存在！")
(princ)
)
(progn
(setq x 2)
(setq fx (- (/ (sin (/ x 2)) x) (/ (* 0.5 l) s)))
(setq
flx (/ (- (* 0.5 x (cos (* 0.5 x))) (sin (* 0.5 x))) (* x x))
)
(setq xx (- x (/ fx flx)))
(while (> (abs (- x xx)) 0.0000000001)
(setq x xx)
(setq fx (- (/ (sin (/ x 2)) x) (/ (* 0.5 l) s)))
(setq flx
(/ (- (* 0.5 x (cos (* 0.5 x))) (sin (* 0.5 x))) (* x x))
)
(setq xx (- x (/ fx flx)))
)
(setq r (/ s xx))

(initget "N S")
(setq aa (getkword "\n 请输入圆弧方向[逆时针(N)/顺时针(S)]:"))
(if (= aa nil)
(setq aa "N")
)
(if (= aa "N")
(N)
(if (= aa "S")
(progn
(setq c (- (+ a (/ x 2)) (* 0.5 pi)))
(setq cen (polar p1 c r))
(setq c1 (- (+ c pi) x))
(setq c2 (+ c pi))
(setq myobj (vla-addarc mspace (vlax-3d-point cen) r c1 c2))
(princ)
)
)
)
)
)
)

dunkel

这个代码中使用到了 vla 类的函数, 但 R14 英文版是不代内嵌的 vba 的, 中文版的好像有, 但解密不一定完全, 使用中可能会有意外. 如果不想再麻烦那个老兄将 vla 语句修改为普通的 lsp 语句的话, 就去找个 vba for R14 安装下

Joseflin

此Lisp寫得很好，只可惜名稱為aaa不容易看出它的用途。我試過2004運行無礙。

highflybir

首先申明这个程序源于ahlzl--几何算法的版主。
我在这里做了些改动，以便能适应R14及以下版本。

3. (prompt "\n请输入命令AAA!")
4. (defun c:aaa (/ P1 P2 S A L x xx Fx Dx key cen rad an1 an2 mid)
5.   ;;圆心角与弧长和弦长的函数关系
6.   (defun func (x S)
7.     (- (* 2 (sin (/ x 2)) S) (* L x))
8.   )
9.   ;;上面函数的求导
10.   (defun diff (x S)
11.     (- (* S (cos (/ x 2))) L)
12.   )
13.   ;;输入数据
14.   (initget 1)
15.   (if (and (setq P1 (getpoint "\n请输入圆弧起点:"))
16.     (setq P2 (getpoint P1 "\n请输入圆弧端点:"))
17.     (setq S  (getdist "\n请输入弧长:"))
18.     (setq L  (distance P1 P2))
19.     (> S L)
20.       )
21.     (progn
22.       (setq A  (angle P1 P2))
23.       (setq x  (* 2 Pi))
24.       (setq Fx (func x S))
25.       (setq Dx (diff x S))
26.       (setq xx (- x (/ Fx Dx)))
27.       ;;迭代运算
28.       (while (> (abs (- x xx)) 1e-12)
29. (setq x xx)
30. (setq Fx (func x S))
31. (setq Dx (diff x S))
32. (setq xx (- x (/ Fx Dx)))
33.       )
34.       ;;确定圆弧方向
35.       (initget 0 "N S")
36.       (setq key (getkword "\n请输入圆弧方向[逆时针(N)/顺时针(S)]<N>:"))
37.       (if (null key)
38. (setq key "N")
39.       )
40.       (setq rad (abs (/ s xx)))
41.       (setq mid (polar p1 A (/ l 2)))
42.       ;;准备工作
43.       (if (= key "N")
44. (setq cen (polar mid (+ A (/ pi 2)) (* rad (cos (/ xx 2)))))
45. (setq cen (polar mid (- A (/ pi 2)) (* rad (cos (/ xx 2))))
46.        xx  p1
47.        p1  p2
48.        p2  xx
49. )
50.       )
51.       (setq an1 (angle cen p1))
52.       (setq an2 (angle cen p2))
53.       ;;画圆弧
54.       (entmake
55. (list
56.    '(0 . "ARC")
57.    (cons 10 cen)
58.    (cons 40 rad)
59.    (cons 50 an1)
60.    (cons 51 an2)
61. )
62.       )
63.     )
64.     (alert "输入无效或要画的圆弧不存在!")
65.   )
66.   (princ)
67. )

(prompt "\n请输入命令AAA!") (defun c:aaa (/ P1 P2 S A L x xx Fx Dx key cen rad an1 an2 mid)   ;;圆心角与弧长和弦长的函数关系   (defun func (x S)     (- (* 2 (sin (/ x 2)) S) (* L x))   )   ;;上面函数的求导   (defun diff (x S)     (- (* S (cos (/ x 2))) L)   )   ;;输入数据   (initget 1)   (if (and (setq P1 (getpoint "\n请输入圆弧起点:"))     (setq P2 (getpoint P1 "\n请输入圆弧端点:"))     (setq S  (getdist "\n请输入弧长:"))     (setq L  (distance P1 P2))     (> S L)       )     (progn       (setq A  (angle P1 P2))       (setq x  (* 2 Pi))       (setq Fx (func x S))       (setq Dx (diff x S))       (setq xx (- x (/ Fx Dx)))       ;;迭代运算       (while (> (abs (- x xx)) 1e-12) (setq x xx) (setq Fx (func x S)) (setq Dx (diff x S)) (setq xx (- x (/ Fx Dx)))       )       ;;确定圆弧方向       (initget 0 "N S")       (setq key (getkword "\n请输入圆弧方向[逆时针(N)/顺时针(S)]<N>:"))       (if (null key) (setq key "N")       )       (setq rad (abs (/ s xx)))       (setq mid (polar p1 A (/ l 2)))       ;;准备工作       (if (= key "N") (setq cen (polar mid (+ A (/ pi 2)) (* rad (cos (/ xx 2))))) (setq cen (polar mid (- A (/ pi 2)) (* rad (cos (/ xx 2))))        xx  p1        p1  p2        p2  xx )       )       (setq an1 (angle cen p1))       (setq an2 (angle cen p2))       ;;画圆弧       (entmake (list    '(0 . "ARC")    (cons 10 cen)    (cons 40 rad)    (cons 50 an1)    (cons 51 an2) )       )     )     (alert "输入无效或要画的圆弧不存在!")   )   (princ) )

鬼魔

非常抱歉，现在才看到

这程序确实不是我编的

下次我会写出处

highflybird版主确实很热心，感谢

loner

非常感谢highflybir！

Lotto168

ahlzl與highflybir君的 DIFF函數真漂亮，大大減少迴圈數，感謝！

在此對程式提供一點小小看法，一般畫弧採7個參數方式時，預設為逆時針方向，

所以應可以將提示方向步驟省略，由指定兩點之順序自動畫出該弧(逆時針)，

若是指定兩點之後覺得方向不對，可以在輸入弧長時，輸入負值的方式修正。

Lotto168

利用颱風假，針對以上稍微改寫一下，提供參考:

2. (defun c:aaa (/ pt1 pt2 ll dd ang ang2 Fx Dx)
3.   (setvar "cmdecho" 0)
4.   (setq pt1 (getpoint "\n指定弧的起點: ")
5.         pt2 (getpoint pt1 "\n指定弧的終點: ")
6.         dd  (distance pt1 pt2)
7.   )
8.   (setq chk 0)
9.   (while (= chk 0)
10.     (setq ll  (getdist "\n指定弧長: "))
11.     (if (or (null ll)(>= dd (abs ll)))
12.       (alert "\n輸入無效或要畫的圓弧不存在，請重新設定！")
13.       (if (> ll 0) (setq chk 1) (setq chk -1))
14.     )
15.   )
16.   (setq ll (abs ll)
17.         ang (* 2 pi)
18.         Fx (func ang ll)
19.         Dx (diff ang ll)
20.         ang2 (- ang (/ Fx Dx))
21.   )
23.   ;逼近法求角度
24.   (while (> (abs (- ang ang2)) 1e-12)
25.     (setq ang ang2
26.           Fx (func ang ll)
27.           Dx (diff ang ll)
28.           ang2 (- ang (/ Fx Dx))
29.     )
30.   )
32.   ;以SEA方式畫弧，採系統預設的逆時針方向作圖
33.   (setq ang (/ (* ang 180.0 chk) pi))
34.   (command "arc" pt1 "e" pt2 "a" ang)
35.   (setvar "cmdecho" 1)
36.   (princ)
37. )
38. (prompt "\n請輸入指令 ---> AAA")
39. ;自訂函數區
40. (defun func (ang ll)
41.   (- (* 2 ll (sin (/ ang 2))) (* dd ang))
42. )
43. (defun diff (ang ll)
44.   (- (* ll (cos (/ ang 2))) dd)
45. )

(defun c:aaa (/ pt1 pt2 ll dd ang ang2 Fx Dx)   (setvar "cmdecho" 0)   (setq pt1 (getpoint "\n指定弧的起點: ")         pt2 (getpoint pt1 "\n指定弧的終點: ")         dd  (distance pt1 pt2)   )   (setq chk 0)   (while (= chk 0)     (setq ll  (getdist "\n指定弧長: "))     (if (or (null ll)(>= dd (abs ll)))       (alert "\n輸入無效或要畫的圓弧不存在，請重新設定！")       (if (> ll 0) (setq chk 1) (setq chk -1))     )   )   (setq ll (abs ll)         ang (* 2 pi)         Fx (func ang ll)         Dx (diff ang ll)         ang2 (- ang (/ Fx Dx))   )   ;逼近法求角度   (while (> (abs (- ang ang2)) 1e-12)     (setq ang ang2           Fx (func ang ll)           Dx (diff ang ll)           ang2 (- ang (/ Fx Dx))     )   )   ;以SEA方式畫弧，採系統預設的逆時針方向作圖   (setq ang (/ (* ang 180.0 chk) pi))   (command "arc" pt1 "e" pt2 "a" ang)   (setvar "cmdecho" 1)   (princ) ) (prompt "\n請輸入指令 ---> AAA") ;自訂函數區 (defun func (ang ll)   (- (* 2 ll (sin (/ ang 2))) (* dd ang)) ) (defun diff (ang ll)   (- (* ll (cos (/ ang 2))) dd) )