9套参数快速绘制圆弧（第二版）

newer · 发表于 2018-8-9 20:30:34

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

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

×

(defun c:XDTB_FASTARC (/ #endpoint #length #midpoint
#startpoint an an1 arclen
box c cen chordHeight
chordlen code ean endR flx
fx g h ii iii
info l p1 p2 p3
pts r ret san ss
startR TextButton2 UpperLeftY
x xx
)
(setq xd-fast-arc-odcl
'
("YWt6A8QpAADRDw4hBuKTJLUxbT9igPQmWCRva2v99xGP3u+saPRZXbi6iX1sHapuztZWHJztDo+c"
"P915URTcYDLCBo7/9/H9T1jgihjClr9BvnrhaVFUhuVh28WNFdetEjdpzcXno4cIiElFRaEAobJq"
"1Pj5+O8wm/2TddD6CanL+X7C037YlnJrUvPcfTeg5W/ZA2ssFjp9xFZp2RVXSi9QN5lQCixQOBnD"
"2ZbgMEBZloCGtv34C/Njau/czARUE7p/9DcuIKHZFapLqS3Q7RQ0D1D3/cqVRdziCvVK1Do6SQxU"
"ikhhVPpM2kmJZddBdtlR+ZYEi3/SvxanlDIQd8jdaVMqC1FL13VDLsnyxgfID1Pq8J1am6tn3fgn"
"hxW2OotlLy69fAFqhtL/FYxDG13bEOLcqj+xlTjBAKALL6Eb/71fbYFsmwN8VQ+BFbJim1sz7qT7"
"DMZIC3Dfr4JZhDaqVTJItBlEm6FL4GpMneFHm/LhdoIqnrl8gQik3XWq7E9A20m4C9ZrMEN96lzE"
"q81mqLSRT8J/Wdap8S/xST6LGmC2a9bdfGG1KmKE10WaxlZBXA7wQFD9tMKhCNnjZUtwZTNVJaAA"
"kNTkXIQ+DK4VujrI3Gt1V2OY8cD5jJWXBraeFPXw5ZMeo17Lvb8JS6BXtOlHBtG4pWICK52z/MVT"
"fBFrBu2+dueRV0fTbYOenIZIrGKxG+bxnSZf4ipf5e1h42EQ8nlZDwadmmAyMKjdiuJqJTDvNwrm"
"vQbbmkasOOOlOWDEcNmXBvQixen42gTW9p/99Q2FjhTya5HyfaNK7GKb3y0zaCCELgaTA/9hdgIx"
"nhyFsFsvgekyIfOeX5kAWJDV9oHydH1Ra4+h4ogOx8PYCF41LZvlJLHJSZEHCS9z9o+Z776d3sVk"
"YwkzqpWsn0DmRBL9170U83n7UCLEwn4t6fkvJCPQOyQ5zWcYlxYUUGNKNWtTVDo7s//4Lipzq1wl"
"PQQihCFLinzY+ByO9/jUZ6QXVidy+MsthO8fGK67jlPmco1pTr9miBwHt76MjhG1nUeF9lqMs6fd"
"2yLpj+lSqH4LQCPpTwjXlm00wXge4eK/rrBZ5cKwWIvUp9Fd3ynhip0SrPUxSHtAd3XhqmTUHBLZ"
"3zgx2kp42ibuLP41oz/INZdPutHNx4NOI9Rr2DWX4SyNxyp82DVDOZcj9EtK49/j+Gy7HqbRne4g"
"gsVnwHftH4D7CfxPkruMbP+bvwxi1BoS2d8GX2SUP5DH4iEjrJXRZILAUHPjubqoLkKublJLSvPP"
"4/gc4Db3e9om7ix66ZzBdYSu28LQRoOWLNLfdj1Fc0tqvI41muC1h+sf0c2LB05nAPEPGQZS7LgP"
"ChR28m7o3S1zHUUbO0PvbHM2z17bdqC7gTeaPZGMxHBT/wmDrduKiGlskaem"
)
)
(defun c:快速圆弧/快速圆弧#OnInitialize (/)
(dcl-Control-SetEnabled TextButton2 nil) ; (dcl-Control-SetVisible
; TextButton2 nil)
(xdrx_sysvar_push '("orthomode" 0))
(princ)
)
;|
(defun c:快速圆弧/快速圆弧#OnCancelClose (Reason /)
(dcl-form-close 快速圆弧/快速圆弧)
(xdrx_sysvar_pop)
)
(defun c:快速圆弧/快速圆弧#OnCancel (/)
(dcl-form-close 快速圆弧/快速圆弧)
(xdrx_sysvar_pop)
)
(defun c:快速圆弧/快速圆弧#OnClose (UpperLeftX UpperLeftY /)
(dcl-form-close 快速圆弧/快速圆弧)
(xdrx_sysvar_pop)
)
|;
(defun c:快速圆弧/快速圆弧/TextButton1#OnClicked (/)
(dcl-sendstring "(_drawarc 0)\n")
(princ)
)
(defun c:快速圆弧/快速圆弧/TextButton2#OnClicked (/)
(dcl-sendstring "(_drawarc 1)\n")
(princ)
)
(defun c:快速圆弧/快速圆弧/TextButton5#OnClicked (/)
(dcl-sendstring "(_drawarc 2)\n")
(princ)
)
(defun c:快速圆弧/快速圆弧/TextButton6#OnClicked (/)
(dcl-sendstring "(_drawarc 3)\n")
(princ)
)
(defun c:快速圆弧/快速圆弧/TextButton3#OnClicked (/)
(dcl-sendstring "(_drawarc 4)\n")
(princ)
)
(defun c:快速圆弧/快速圆弧/TextButton4#OnClicked (/)
(dcl-sendstring "(_drawarc 5)\n")
(princ)
)
(defun c:快速圆弧/快速圆弧/TextButton7#OnClicked (/)
(dcl-sendstring "(_drawarc 6)\n")
(princ)
)
(defun c:快速圆弧/快速圆弧/TextButton10#OnClicked (/)
(dcl-sendstring "(_drawarc 7)\n")
(princ)
)
(defun c:快速圆弧/快速圆弧/TextButton8#OnClicked (/)
(dcl-sendstring "(_drawarc 8)\n")
(princ)
)
(defun c:快速圆弧/快速圆弧/TextButton9#OnClicked (/)
(dcl-sendstring "(_drawarc 9)\n")
(princ)
)
(defun xd::geom:arc<-len&chord (arclen chordlen)
(if (> arclen chordlen)
(progn
(setq x 2)
(setq fx (- (/ (sin (/ x 2)) x) (/ (* 0.5 chordlen) arclen)))
(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 chordlen) arclen)))
(setq flx (/ (- (* 0.5 x (cos (* 0.5 x))) (sin (* 0.5 x)))
(* x x)
)
)
(setq xx (- x (/ fx flx)))
)
(setq r (/ arclen xx))
(list r x)
)
)
)
(defun xd::geom:arc<-ChordLen&ChordHeight (chordlen chordHeight)
(if (> chordlen chordHeight)
(progn
(setq r (/ (+ (* (/ chordlen 2.0) (/ chordlen 2.0))
(* chordHeight
chordHeight
)
)
(* 2 chordHeight)
)
an (xdrx_math_asin (/ (/ chordlen 2.0) r))
an (* 2 an)
)
(list r an)
)
)
)
(defun xd::geom:arc<-ArcLen&Radius (arcLen r)
(setq c (* 2 pi r)
an (* (/ arclen c) 2 pi)
)
(list r an)
)
(defun xd::geom:arc<-ArcLen&Angle (arcLen an)
(setq an (* pi (/ an 180)))
(setq r (/ arclen an))
(list r an)
)
(defun xd::geom:arc<-ChordHeight&Angle (chordLen an)
(setq an (* pi (/ an 180)))
(setq r (/ chordlen (- 1 (cos (/ an 2.0)))))
(list r an)
)
(defun _getVal (g arcLen)
(setq iii (1+ iii))
(if (> iii ii)
(exit)
)
(xdge::getpropertyvalue
g "length" "startpoint" "midpoint" "endpoint")
(princ "\n")
(princ "lenght=")
(princ #length)
(princ " arclen=")
(princ arclen)
(setq p2 #midpoint
cen (xdrx_midp #startpoint #endpoint)
l (distance #startpoint #endpoint)
l (/ l 2.0)
)
(princ " l=")
(princ l)
(princ " spt=")
(princ #startpoint)
(princ " mid=")
(princ #midpoint)
(princ " end=")
(princ #endpoint)
(if (not (equal (abs (- arclen #length)) 0.0 1e-5))
(progn
(if (> #length arclen)
(progn
(princ " ok！")
(setq p1 (polar '(0 0 0) 0.0 (* 0.5 l))
p3 (polar '(0 0 0) pi (* 0.5 l))
)
)
(progn
(princ " <<<！")
(setq p1 (polar '(0 0 0) 0.0 (* 2 l))
p3 (polar '(0 0 0) pi (* 2 l))
)
)
)
(xdge::setpropertyvalue g "set" p1 p2 p3)
(_getval g arclen)
)
)
)
(setq ii 10)
(defun xd::geom:arc<-ArcLen&ChordHeight (arcLen chordHeight)
(setq cen '(0 0 0)
startR 0.0
endR chordHeight
)
(setq p1 (polar cen 0.0 endR)
p2 (polar cen (/ pi 2.0) endR)
p3 (polar cen pi endR)
)
(setq g (xdge::constructor "kCircArc3d" p1 p2 p3))
(setq iii 0)
(_getval g arclen)
(setq ret (xdge::getpropertyvalue g "radius" "startang" "endang"))
;
; (xdge::free g)
(list (car ret) (- (last ret) (cadr ret)))
)
(defun _get3p (info)
(setq r (car info)
an (last info)
)
(if (> an PI)
(progn
(setq san (/ (- an pi) 2.0)
ean (+ pi san)
san (- san)
)
)
(progn
(setq san (/ (- pi an) 2.0)
ean (- pi san)
)
)
)
(setq p1 (polar cen san r)
p3 (polar cen ean r)
p2 (polar cen (+ san (/ an 2.0)) r)
)
(list p1 p2 p3)
)
(defun _drawarc (code / p1 p2 p3 info)
(setq cen '(0 0 0))
(cond
((= code 0)
(and
(setq arclen (getreal "\n输入弧长<退出>:"))
(setq chordlen (getreal "\n输入弦长<退出>:"))
(setq info (xd::geom:arc<-len&chord arclen chordlen))
)
)
((= code 1)
(and
(setq arclen (getreal "\n输入弧长<退出>:"))
(setq chordheight (getreal "\n输入弦高<退出>:"))
(setq
info (xd::geom:arc<-ArcLen&chordHeight arclen chordheight)
)
)
)
((= code 2)
(and
(setq arclen (getreal "\n输入弧长<退出>:"))
(setq an (getreal "\n输入夹角(度)<退出>:"))
(setq info (xd::geom:arc<-Arclen&Angle arclen an))
)
)
((= code 3)
(and
(setq arclen (getreal "\n输入弧长<退出>:"))
(setq r (getreal "\n输入半径<退出>:"))
(setq info (xd::geom:arc<-Arclen&Radius arclen r))
)
)
((= code 4)
(if (not (setq chordlen (getreal "\n输入弦长<取点>:")))
(progn
(if (and (setq p1 (getpoint "\n弦长第一点<退出>:"))
(setq p2 (getpoint p1 "\n弦长第二点<退出>:"))
)
(setq chordlen (distance p1 p2))
)
)
)
(if (and chordlen
(setq chordheight (getreal "\n输入拱高<退出>:"))
)
(progn
(setq info (xd::geom:arc<-ChordLen&ChordHeight
chordlen
chordheight
)
)
)
)
)
((= code 5)
(if (not (setq chordlen (getreal "\n输入弦长<取点>:")))
(progn
(if (and (setq p1 (getpoint "\n弦长第一点<退出>:"))
(setq p2 (getpoint p1 "\n弦长第二点<退出>:"))
)
(setq chordlen (distance p1 p2))
)
)
)
(if (and chordlen
(setq r (getreal "\n输入半径<退出>:"))
(< chordlen (* 2 r))
)
(setq
info (list r (* 2 (xdrx_math_asin (/ (/ chordlen 2.0) r))))
)
)
)
((= code 6)
(if (not (setq chordlen (getreal "\n输入弦长<取点>:")))
(progn
(if (and (setq p1 (getpoint "\n弦长第一点<退出>:"))
(setq p2 (getpoint p1 "\n弦长第二点<退出>:"))
)
(setq chordlen (distance p1 p2))
)
)
)
(if (and chordlen (setq an (getreal "\n输入夹角<退出>:")))
(progn
(setq an (* pi (/ an 180.0)))
(setq an1 (if (> an pi)
(setq an1 (- (* 2 pi) an))
an
)
)
(setq info (list (/ chordlen (sin (/ an1 2.0))) an))
)
)
)
((= code 7)
(and
(setq r (getreal "\n输入半径<退出>:"))
(setq an (getreal "\n输入夹角<退出>:"))
(setq an (* pi (/ an 180.0)))
(setq info (list r an))
)
)
((= code 8)
(and
(setq h (getreal "\n输入拱高<退出>:"))
(setq r (getreal "\n输入半径<退出>:"))
(< h (* 2 r))
(setq info (list r (* 2 (xdrx_math_acos (/ (- r h) r)))))
)
)
((= code 9)
(and
(setq h (getreal "\n输入拱高<退出>:"))
(setq an (getreal "\n输入夹角(度)<退出>:"))
(setq info (xd::geom:arc<-ChordHeight&Angle h an))
)
)
)
(if (and
info
(setq pts (_get3p info))
(setq g (xdge::constructor
"kcircarc3d"
(car pts)
(cadr pts)
(caddr pts)
)
)
)
(progn
(xdrx_begin)
(xdge::entity:make g)
(setq ss (ssadd)
#arc (entlast)
ss (ssadd (entlast) ss)
)
;(XD::Pickset:Drag (entlast) '(0 0 0) (+ 1 2 4 8 16 32 128) 0 nil)
(xd::pickset:drag
ss
(xdge::getpropertyvalue g "center")
(+ 1 2 4 8 16 32 64 128)
0
nil
)
;(xd::drag:simplemove ss "\n插入点:" 5 t)
(xdge::free g)
(xdrx_end)
)
(xdrx_prompt "\n输入的数据不能生成圆弧，请检查数据.")
)
(princ)
)
(dcl-project-import xd-fast-arc-odcl)
(dcl-Form-Show 快速圆弧/快速圆弧)
(setq box (xdrx_drawing_pixelbox))
(dcl_Form_SetPos
快速圆弧/快速圆弧
(car (last box))
(cadr (last box))
)
(princ)
)

(defun c:XDTB_FASTARC (/        #endpoint          #length  #midpoint 
                       #startpoint         an          an1           arclen 
                       box        c         cen          chordHeight 
                       chordlen        code         ean          endR           flx 
                       fx        g         h          ii           iii 
                       info        l         p1          p2           p3 
                       pts        r         ret          san           ss 
                       startR        TextButton2          UpperLeftY 
                       x        xx 
                      ) 
  (setq        xd-fast-arc-odcl 
         ' 
          ("YWt6A8QpAADRDw4hBuKTJLUxbT9igPQmWCRva2v99xGP3u+saPRZXbi6iX1sHapuztZWHJztDo+c" 
           "P915URTcYDLCBo7/9/H9T1jgihjClr9BvnrhaVFUhuVh28WNFdetEjdpzcXno4cIiElFRaEAobJq" 
           "1Pj5+O8wm/2TddD6CanL+X7C037YlnJrUvPcfTeg5W/ZA2ssFjp9xFZp2RVXSi9QN5lQCixQOBnD" 
           "2ZbgMEBZloCGtv34C/Njau/czARUE7p/9DcuIKHZFapLqS3Q7RQ0D1D3/cqVRdziCvVK1Do6SQxU" 
           "ikhhVPpM2kmJZddBdtlR+ZYEi3/SvxanlDIQd8jdaVMqC1FL13VDLsnyxgfID1Pq8J1am6tn3fgn" 
           "hxW2OotlLy69fAFqhtL/FYxDG13bEOLcqj+xlTjBAKALL6Eb/71fbYFsmwN8VQ+BFbJim1sz7qT7" 
           "DMZIC3Dfr4JZhDaqVTJItBlEm6FL4GpMneFHm/LhdoIqnrl8gQik3XWq7E9A20m4C9ZrMEN96lzE" 
           "q81mqLSRT8J/Wdap8S/xST6LGmC2a9bdfGG1KmKE10WaxlZBXA7wQFD9tMKhCNnjZUtwZTNVJaAA" 
           "kNTkXIQ+DK4VujrI3Gt1V2OY8cD5jJWXBraeFPXw5ZMeo17Lvb8JS6BXtOlHBtG4pWICK52z/MVT" 
           "fBFrBu2+dueRV0fTbYOenIZIrGKxG+bxnSZf4ipf5e1h42EQ8nlZDwadmmAyMKjdiuJqJTDvNwrm" 
           "vQbbmkasOOOlOWDEcNmXBvQixen42gTW9p/99Q2FjhTya5HyfaNK7GKb3y0zaCCELgaTA/9hdgIx" 
           "nhyFsFsvgekyIfOeX5kAWJDV9oHydH1Ra4+h4ogOx8PYCF41LZvlJLHJSZEHCS9z9o+Z776d3sVk" 
           "YwkzqpWsn0DmRBL9170U83n7UCLEwn4t6fkvJCPQOyQ5zWcYlxYUUGNKNWtTVDo7s//4Lipzq1wl" 
           "PQQihCFLinzY+ByO9/jUZ6QXVidy+MsthO8fGK67jlPmco1pTr9miBwHt76MjhG1nUeF9lqMs6fd" 
           "2yLpj+lSqH4LQCPpTwjXlm00wXge4eK/rrBZ5cKwWIvUp9Fd3ynhip0SrPUxSHtAd3XhqmTUHBLZ" 
           "3zgx2kp42ibuLP41oz/INZdPutHNx4NOI9Rr2DWX4SyNxyp82DVDOZcj9EtK49/j+Gy7HqbRne4g" 
           "gsVnwHftH4D7CfxPkruMbP+bvwxi1BoS2d8GX2SUP5DH4iEjrJXRZILAUHPjubqoLkKublJLSvPP" 
           "4/gc4Db3e9om7ix66ZzBdYSu28LQRoOWLNLfdj1Fc0tqvI41muC1h+sf0c2LB05nAPEPGQZS7LgP" 
           "ChR28m7o3S1zHUUbO0PvbHM2z17bdqC7gTeaPZGMxHBT/wmDrduKiGlskaem" 
          ) 
  ) 
  (defun c:快速圆弧/快速圆弧#OnInitialize (/) 
    (dcl-Control-SetEnabled TextButton2 nil) ; (dcl-Control-SetVisible 
 ; TextButton2 nil) 
    (xdrx_sysvar_push '("orthomode" 0)) 
    (princ) 
  ) 
  ;| 
  (defun c:快速圆弧/快速圆弧#OnCancelClose (Reason /) 
    (dcl-form-close 快速圆弧/快速圆弧) 
    (xdrx_sysvar_pop) 
  ) 
  (defun c:快速圆弧/快速圆弧#OnCancel (/) 
    (dcl-form-close 快速圆弧/快速圆弧) 
    (xdrx_sysvar_pop) 
  ) 
  (defun c:快速圆弧/快速圆弧#OnClose (UpperLeftX UpperLeftY /) 
    (dcl-form-close 快速圆弧/快速圆弧) 
    (xdrx_sysvar_pop) 
  ) 
  |; 
  (defun c:快速圆弧/快速圆弧/TextButton1#OnClicked (/) 
    (dcl-sendstring "(_drawarc 0)\n") 
    (princ) 
  ) 
  (defun c:快速圆弧/快速圆弧/TextButton2#OnClicked (/) 
    (dcl-sendstring "(_drawarc 1)\n") 
    (princ) 
  ) 
  (defun c:快速圆弧/快速圆弧/TextButton5#OnClicked (/) 
    (dcl-sendstring "(_drawarc 2)\n") 
    (princ) 
  ) 
  (defun c:快速圆弧/快速圆弧/TextButton6#OnClicked (/) 
    (dcl-sendstring "(_drawarc 3)\n") 
    (princ) 
  ) 
  (defun c:快速圆弧/快速圆弧/TextButton3#OnClicked (/) 
    (dcl-sendstring "(_drawarc 4)\n") 
    (princ) 
  ) 
  (defun c:快速圆弧/快速圆弧/TextButton4#OnClicked (/) 
    (dcl-sendstring "(_drawarc 5)\n") 
    (princ) 
  ) 
  (defun c:快速圆弧/快速圆弧/TextButton7#OnClicked (/) 
    (dcl-sendstring "(_drawarc 6)\n") 
    (princ) 
  ) 
  (defun c:快速圆弧/快速圆弧/TextButton10#OnClicked (/) 
    (dcl-sendstring "(_drawarc 7)\n") 
    (princ) 
  ) 
  (defun c:快速圆弧/快速圆弧/TextButton8#OnClicked (/) 
    (dcl-sendstring "(_drawarc 8)\n") 
    (princ) 
  ) 
  (defun c:快速圆弧/快速圆弧/TextButton9#OnClicked (/) 
    (dcl-sendstring "(_drawarc 9)\n") 
    (princ) 
  ) 
  (defun xd::geom:arc<-len&chord (arclen chordlen) 
    (if        (> arclen chordlen) 
      (progn 
        (setq x 2) 
        (setq fx (- (/ (sin (/ x 2)) x) (/ (* 0.5 chordlen) arclen))) 
        (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 chordlen) arclen))) 
          (setq        flx (/ (- (* 0.5 x (cos (* 0.5 x))) (sin (* 0.5 x))) 
                       (* x x) 
                    ) 
          ) 
          (setq xx (- x (/ fx flx))) 
        ) 
        (setq r (/ arclen xx)) 
        (list r x) 
      ) 
    ) 
  ) 
  (defun xd::geom:arc<-ChordLen&ChordHeight (chordlen chordHeight) 
    (if        (> chordlen chordHeight) 
      (progn 
        (setq r         (/ (+ (* (/ chordlen 2.0) (/ chordlen 2.0)) 
                       (* chordHeight 
                          chordHeight 
                       ) 
                    ) 
                    (* 2 chordHeight) 
                 ) 
              an (xdrx_math_asin (/ (/ chordlen 2.0) r)) 
              an (* 2 an) 
        ) 
        (list r an) 
      ) 
    ) 
  ) 
  (defun xd::geom:arc<-ArcLen&Radius (arcLen r) 
    (setq c  (* 2 pi r) 
          an (* (/ arclen c) 2 pi) 
    ) 
    (list r an) 
  ) 
  (defun xd::geom:arc<-ArcLen&Angle (arcLen an) 
    (setq an (* pi (/ an 180))) 
    (setq r (/ arclen an)) 
    (list r an) 
  ) 
  (defun xd::geom:arc<-ChordHeight&Angle (chordLen an) 
    (setq an (* pi (/ an 180))) 
    (setq r (/ chordlen (- 1 (cos (/ an 2.0))))) 
    (list r an) 
  ) 
  (defun _getVal (g arcLen) 
    (setq iii (1+ iii)) 
    (if        (> iii ii) 
      (exit) 
    ) 
    (xdge::getpropertyvalue 
      g        "length" "startpoint" "midpoint" "endpoint") 
    (princ "\n") 
    (princ "lenght=") 
    (princ #length) 
    (princ "  arclen=") 
    (princ arclen) 
    (setq p2  #midpoint 
          cen (xdrx_midp #startpoint #endpoint) 
          l   (distance #startpoint #endpoint) 
          l   (/ l 2.0) 
    ) 
    (princ "  l=") 
    (princ l) 
    (princ "  spt=") 
    (princ #startpoint) 
    (princ " mid=") 
    (princ #midpoint) 
    (princ " end=") 
    (princ #endpoint) 
    (if        (not (equal (abs (- arclen #length)) 0.0 1e-5)) 
      (progn 
        (if (> #length arclen) 
          (progn 
            (princ "   ok！") 
            (setq p1 (polar '(0 0 0) 0.0 (* 0.5 l)) 
                  p3 (polar '(0 0 0) pi (* 0.5 l)) 
            ) 
          ) 
          (progn 
            (princ "   <<<！") 
            (setq p1 (polar '(0 0 0) 0.0 (* 2 l)) 
                  p3 (polar '(0 0 0) pi (* 2 l)) 
            ) 
          ) 
        ) 
        (xdge::setpropertyvalue g "set" p1 p2 p3) 
        (_getval g arclen) 
      ) 
    ) 
  ) 
  (setq ii 10) 
  (defun xd::geom:arc<-ArcLen&ChordHeight (arcLen chordHeight) 
    (setq cen         '(0 0 0) 
          startR 0.0 
          endR         chordHeight 
    ) 
    (setq p1 (polar cen 0.0 endR) 
          p2 (polar cen (/ pi 2.0) endR) 
          p3 (polar cen pi endR) 
    ) 
    (setq g (xdge::constructor "kCircArc3d" p1 p2 p3)) 
    (setq iii 0) 
    (_getval g arclen) 
    (setq ret (xdge::getpropertyvalue g "radius" "startang" "endang")) 
 ; 
 ; (xdge::free g) 
    (list (car ret) (- (last ret) (cadr ret))) 
  ) 
  (defun _get3p        (info) 
    (setq r  (car info) 
          an (last info) 
    ) 
    (if        (> an PI) 
      (progn 
        (setq san (/ (- an pi) 2.0) 
              ean (+ pi san) 
              san (- san) 
        ) 
      ) 
      (progn 
        (setq san (/ (- pi an) 2.0) 
              ean (- pi san) 
        ) 
      ) 
    ) 
    (setq p1 (polar cen san r) 
          p3 (polar cen ean r) 
          p2 (polar cen (+ san (/ an 2.0)) r) 
    ) 
    (list p1 p2 p3) 
  ) 
  (defun _drawarc (code / p1 p2 p3 info) 
    (setq cen '(0 0 0)) 
    (cond 
      ((= code 0) 
       (and 
         (setq arclen (getreal "\n输入弧长<退出>:")) 
         (setq chordlen (getreal "\n输入弦长<退出>:")) 
         (setq info (xd::geom:arc<-len&chord arclen chordlen)) 
       ) 
      ) 
      ((= code 1) 
       (and 
         (setq arclen (getreal "\n输入弧长<退出>:")) 
         (setq chordheight (getreal "\n输入弦高<退出>:")) 
         (setq 
           info        (xd::geom:arc<-ArcLen&chordHeight arclen chordheight) 
         ) 
       ) 
      ) 
      ((= code 2) 
       (and 
         (setq arclen (getreal "\n输入弧长<退出>:")) 
         (setq an (getreal "\n输入夹角(度)<退出>:")) 
         (setq info (xd::geom:arc<-Arclen&Angle arclen an)) 
       ) 
      ) 
      ((= code 3) 
       (and 
         (setq arclen (getreal "\n输入弧长<退出>:")) 
         (setq r (getreal "\n输入半径<退出>:")) 
         (setq info (xd::geom:arc<-Arclen&Radius arclen r)) 
       ) 
      ) 
      ((= code 4) 
       (if (not (setq chordlen (getreal "\n输入弦长<取点>:"))) 
         (progn 
           (if (and (setq p1 (getpoint "\n弦长第一点<退出>:")) 
                    (setq p2 (getpoint p1 "\n弦长第二点<退出>:")) 
               ) 
             (setq chordlen (distance p1 p2)) 
           ) 
         ) 
       ) 
       (if (and        chordlen 
                (setq chordheight (getreal "\n输入拱高<退出>:")) 
           ) 
         (progn 
           (setq info (xd::geom:arc<-ChordLen&ChordHeight 
                        chordlen 
                        chordheight 
                      ) 
           ) 
         ) 
       ) 
      ) 
      ((= code 5) 
       (if (not (setq chordlen (getreal "\n输入弦长<取点>:"))) 
         (progn 
           (if (and (setq p1 (getpoint "\n弦长第一点<退出>:")) 
                    (setq p2 (getpoint p1 "\n弦长第二点<退出>:")) 
               ) 
             (setq chordlen (distance p1 p2)) 
           ) 
         ) 
       ) 
       (if (and        chordlen 
                (setq r (getreal "\n输入半径<退出>:")) 
                (< chordlen (* 2 r)) 
           ) 
         (setq 
           info        (list r (* 2 (xdrx_math_asin (/ (/ chordlen 2.0) r)))) 
         ) 
       ) 
      ) 
      ((= code 6) 
       (if (not (setq chordlen (getreal "\n输入弦长<取点>:"))) 
         (progn 
           (if (and (setq p1 (getpoint "\n弦长第一点<退出>:")) 
                    (setq p2 (getpoint p1 "\n弦长第二点<退出>:")) 
               ) 
             (setq chordlen (distance p1 p2)) 
           ) 
         ) 
       ) 
       (if (and chordlen (setq an (getreal "\n输入夹角<退出>:"))) 
         (progn 
           (setq an (* pi (/ an 180.0))) 
           (setq an1 (if (> an pi) 
                       (setq an1 (- (* 2 pi) an)) 
                       an 
                     ) 
           ) 
           (setq info (list (/ chordlen (sin (/ an1 2.0))) an)) 
         ) 
       ) 
      ) 
      ((= code 7) 
       (and 
         (setq r (getreal "\n输入半径<退出>:")) 
         (setq an (getreal "\n输入夹角<退出>:")) 
         (setq an (* pi (/ an 180.0))) 
         (setq info (list r an)) 
       ) 
      ) 
      ((= code 8) 
       (and 
         (setq h (getreal "\n输入拱高<退出>:")) 
         (setq r (getreal "\n输入半径<退出>:")) 
         (< h (* 2 r)) 
         (setq info (list r (* 2 (xdrx_math_acos (/ (- r h) r))))) 
       ) 
      ) 
      ((= code 9) 
       (and 
         (setq h (getreal "\n输入拱高<退出>:")) 
         (setq an (getreal "\n输入夹角(度)<退出>:")) 
         (setq info (xd::geom:arc<-ChordHeight&Angle h an)) 
       ) 
      ) 
    ) 
    (if        (and 
          info 
          (setq pts (_get3p info)) 
          (setq        g (xdge::constructor 
                    "kcircarc3d" 
                    (car pts) 
                    (cadr pts) 
                    (caddr pts) 
                  ) 
          ) 
        ) 
      (progn 
        (xdrx_begin) 
        (xdge::entity:make g) 
        (setq ss   (ssadd) 
              #arc (entlast) 
              ss   (ssadd (entlast) ss) 
        ) 
 ;(XD::Pickset:Drag (entlast) '(0 0 0) (+ 1 2 4 8 16 32 128) 0 nil) 
        (xd::pickset:drag 
          ss 
          (xdge::getpropertyvalue g "center") 
          (+ 1 2 4 8 16 32 64 128) 
          0 
          nil 
        ) 
 ;(xd::drag:simplemove ss "\n插入点:" 5 t) 
        (xdge::free g) 
        (xdrx_end) 
      ) 
      (xdrx_prompt "\n输入的数据不能生成圆弧，请检查数据.") 
    ) 
    (princ) 
  ) 
  (dcl-project-import xd-fast-arc-odcl) 
  (dcl-Form-Show 快速圆弧/快速圆弧) 
  (setq box (xdrx_drawing_pixelbox)) 
  (dcl_Form_SetPos 
    快速圆弧/快速圆弧 
    (car (last box)) 
    (cadr (last box)) 
  ) 
  (princ) 
)

zhangfaren · 发表于 2018-8-9 21:29:52

N版太给力了！

jingnanbei · 发表于 2019-7-19 11:54:37

已知弦长和拱高，能够批量绘制圆弧，并标注导出弦长、拱高、弧长和半径吗？

xoyo88 · 发表于 2019-10-25 10:13:37

绘制圆弧，好东东

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

[工具] 9套参数快速绘制圆弧（第二版）

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