设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 从来人生疲画弧
123下一页
返回列表 发新帖
查看: 967|回复: 23

[经验] 从来人生疲画弧

  [复制链接]
尘缘一生
发表于 2024-7-20 18:26:44 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 2024-7-20 19:41 编辑




  2. ;;两点圆弧(以弧长决定方式的探索)---
  3. ;;Modify by SLdesign V3.0 尘缘一生 QQ:15290049 2024年7月20号
  4. (defun c:2parc (/ p1 p2 l s ang aa)
  5.   (defun inputbox-arc (dval / dcl_id dis)
  6.     (defun inputbox-dcl-arc (/ lst_str)
  7.       (setq lst_str
  8.         (list
  9.           "inputbox:dialog {"
  10.           (strcat "label="" (slmsg "输入弧长" "块┓" "Input arc length") """ ";")
  11.           "initial_focus=tile0;"
  12.           $boxed_row
  13.           (strcat "label="" (slmsg "弧长定式画弧" "┓﹚Α礶┓" "Determine the arc drawing method based on the arc length") "";")
  14.           ":button {label="2Pd<--"; key="2-p-d";}"
  15.           ":tile {}"
  16.           ":edit_box {"
  17.           (strcat "label="" (slmsg "弧长 >=" "┓ >=" "arc length >=") """ ";")
  18.           "key="tile0";"
  19.           (strcat "value="" dval """ ";")
  20.           "edit_width=8;"
  21.           "allow_accept=true;"
  22.           "}}"
  23.           $row
  24.           ":tile {}:tile {}"
  25.           $okbt $canbt
  26.           ":tile {}:tile {}"
  27.           "}}"
  28.         )
  29.       )
  30.       (dcl2lisp lst_str)
  31.     )
  32.     ;;---------
  33.     (defun doddarc ()
  34.       (setq Restr (rtos (* 0.9 (atof dval)) 2 2))
  35.       (set_tile "tile0" Restr)
  36.       (done_dialog 1)
  37.     )
  38.     ;;---------
  39.     (setq dcl_id (load_dialog (inputbox-dcl-arc)))
  40.     (new_dialog "inputbox" dcl_id)
  41.     (action_tile "tile0" "(setq Restr $value)")
  42.     (action_tile "2-p-d" "(doddarc)")
  43.     (action_tile "accept" "(done_dialog 1)")
  44.     (action_tile "cancel" "(done_dialog 0)")  ;;退出
  45.     (start_dialog)
  46.     (slunloaddcl dcl_id)
  47.     Restr ;;返回字符串
  48.   )
  49.   ;;---------------
  50.   (setq p1 (getpoint (slmsg "\n 圆弧第一点:" "\n 蛾┓材滁翴:" "\n First point of arc:"))
  51.     p2 (getpoint p1 (slmsg "\n 圆弧第二点:" "\n 蛾┓材翴:" "\n Second point of arc:"))
  52.   )
  53.   (setq l (rtos (* (distance p1 p2) (getvar "dimlfac")) 2 2))
  54.   (setq s (atof (strcase (inputbox-arc l))))
  55.   (setq l (atof l))
  56.   (cond
  57.     ((< s l)
  58.       (2p-dd-arc p1 p2)
  59.     )
  60.     ((= s l)
  61.       (command "arc" p1 "e" p2 "d")
  62.     )
  63.     ((> s l)
  64.       (setq ang (4dire p1))
  65.       (if (or (= ang 0) (= ang 3pi2))
  66.         (setq aa nil)
  67.         (setq aa t)
  68.       )
  69.       (2p-d-arc p1 p2 (/ s (getvar "dimlfac")) aa)
  70.     )
  71.   )
  72. )
  73. ;;两点动态圆弧------(一级)-----
  74. ;;Modify by SLdesign V3.0 尘缘一生 QQ:15290049 2024年7月20号
  75. (defun 2p-dd-arc (p1 p2 / p3 nam nam1 obj nam2 ent ent1 loop bb pt f3 f8 d ang ang0 s0 s s1 s2 s3 kk)
  76.   (command "_.undo" "be")
  77.   (setq s0
  78.     (slmsg
  79.       "\n->动态圆弧 [信息开关(TAB)/扑捉(F3)/正交弧(F8)/定位(Left-Right-Other keys)]"
  80.       "\n->笆篈蛾┓ [獺秨闽(TAB)/汲(F3)/タユ┓(F8)/﹚&#59284;(Left-Right-Other keys)]"
  81.       "\n->Dynamic Arc[Infor Switch(TAB)/Osnap(F3)/Orth Arc(F8)/Location(Left-Right-Other keys)]"
  82.     )
  83.   )
  84.   (setq p3 (polar (sl:mid p1 p2) (setq ang0 (+ (angle p1 p2) pi2)) 10.0) s1 "mm" s2 (slmsg "..开.." "..秨.." "..open..") s3 (slmsg "..关.." "..闽.." "..close.."))
  85.   (make-arc p1 p3 p2)
  86.   (setq nam (entlast))
  87.   (slmkwz (strcat "R=" (rtos (* (getvar "DIMLFAC") (dxf1 nam 40))) s1) p3 3.0 0 nil nil nil 6 "m")
  88.   (setq ent (entget (setq nam1 (entlast))) obj (en2obj nam1))
  89.   (slmkwz (strcat "L=" (rtos (* (getvar "DIMLFAC") (sllen nam))) s1) p3 3.0 0 nil nil nil 6 "m")
  90.   (setq ent1 (entget (setq nam2 (entlast))))
  91.   (setq loop t f3 (getvar "OSMODE") f8 (getvar "ORTHOMODE") s s2)
  92.   (princ (strcat s0 "(" s ")"))
  93.   (while loop
  94.     (setq bb (grread t 15 2))
  95.     (setq pt (cadr bb) d (p2uu 20))
  96.     (cond
  97.       ((equal bb '(2 6));F3切换捕捉开关
  98.         (cond
  99.           ((and (< f3 16384) (/= f3 0))
  100.             (setq f3 (+ f3 16384))
  101.             (prompt (slmsg "\n <对象捕捉 关>" "\n <癸禜 闽>" "\n <OSnap Off>"))
  102.           )
  103.           ((or (= f3 0) (>= f3 16384))
  104.             (setq f3 16383)
  105.             (prompt (slmsg "\n <对象捕捉 开>" "\n <癸禜 秨>" "\n <OSnap On>"))
  106.           )
  107.         )
  108.         (setvar "OSMODE" f3)(redraw)
  109.       )   
  110.       ((equal bb '(2 15))    ;F8切换正交开关
  111.         (if (= f8 0)
  112.           (progn (setq f8 1) (prompt (slmsg "\n <正交 开>" "\n <タユ 秨>" "\n <Orth open>")))
  113.           (progn (setq f8 0) (prompt (slmsg "\n <正交 关>" "\n <タユ 闽>" "\n <Orth off>")))
  114.         )
  115.         (setvar "ORTHOMODE" f8) (redraw)
  116.       )
  117.       ((= (car bb) 5)
  118.         (redraw)
  119.         (if (and (<= f3 16384) (> f3 0))
  120.           (setq pt (slosnappt nam pt) kk t)
  121.         )
  122.         (if (= f8 1)
  123.           (setq pt (pertolinecz pt p3 (polar p3 ang0 50)))
  124.         )
  125.         (grdraw (sl:mid p1 p2) pt 3 2)
  126.         (setq pt (trans pt 1 0))
  127.         (if (sl:pts-onLine (list p1 pt p2))
  128.           (setq pt p3)
  129.         )
  130.         (entdel nam)
  131.         (make-arc p1 pt p2)
  132.         (setq nam (entlast))
  133.         (if (= s s2)
  134.           (progn
  135.             (setq ang (angle-sharp (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv nam (vlax-curve-getparamatpoint nam pt)))))
  136.             (setq pt (polar pt (+ ang pi2) (* 0.7 d)))
  137.             (entmod (emod (emod (emod (emod (emod ent 1 (strcat "R=" (rtos (* (getvar "DIMLFAC") (dxf1 nam 40))) s1)) 10 pt) 11 pt) 40 d) 50 ang))
  138.             (setq pt (polar pt (+ ang pi2) (* 1.3 d)))
  139.             (entmod (emod (emod (emod (emod (emod ent1 1 (strcat "L=" (rtos (* (getvar "DIMLFAC") (sllen nam))) s1)) 10 pt) 11 pt) 40 d) 50 ang))
  140.           )
  141.         )
  142.       )
  143.       ((member bb '((2 9))) ;;table 信息关
  144.         (entdel nam1) (entdel nam2)
  145.         (if (not (vlax-erased-p obj)) (setq s s2) (setq s s3))
  146.         (princ (strcat s0 "(" s ")"))
  147.       )
  148.       ((or t (equal (car bb) 3) (member (car bb) '(11 25)));;左、右、其余键
  149.         (setq loop nil)
  150.       )
  151.     )
  152.   )
  153.   (if kk (sl:erase (ssget "X" (list (cons 8 "f-i-n-d")))))
  154.   (command "_.undo" "e")
  155.   (redraw)
  156. )
  157. ;;两点+弧长+方向  画圆弧-------(一级)-----
  158. ;; s 弧长 ; aa 方向 aa=n nil 逆时针 aa=s 顺时针
  159. ;;Modify by SLdesign V3.0 尘缘一生 QQ:15290049 2024年7月20号
  160. (defun 2p-d-arc (p1 p2 s aa / a l x xx fx flx r c c1 c2)
  161.   (setq a (angle p1 p2))
  162.   (setq l (distance p1 p2))
  163.   (setq x 2)
  164.   (setq fx (- (/ (sin (* 0.5 x)) x) (/ (* 0.5 l) s)))
  165.   (setq flx (/ (- (* 0.5 x (cos (* 0.5 x))) (sin (* 0.5 x))) (* x x)))
  166.   (setq xx (- x (/ fx flx)))
  167.   (while (> (abs (- x xx)) 0.0000000001)
  168.     (setq x xx)
  169.     (setq fx (- (/ (sin (* 0.5 x)) x) (/ (* 0.5 l) s)))
  170.     (setq flx (/ (- (* 0.5 x (cos (* 0.5 x))) (sin (* 0.5 x))) (* x x)))
  171.     (setq xx (- x (/ fx flx)))
  172.   )
  173.   (setq r (/ s xx))
  174.   (if (= aa nil) (setq aa "N") (setq aa "S"))
  175.   (cond
  176.     ((= aa "N")
  177.       (setq c (- (+ a pi2) (* x 0.5)))
  178.       (setq cen (polar p1 c r))
  179.       (setq c1 (+ c pi))
  180.       (setq c2 (+ c1 x))
  181.       (vla-addarc *Model-Space* (vlax-3d-point cen) r c1 c2)
  182.     )
  183.     ((= aa "S")
  184.       (setq c (- (+ a (* 0.5 x)) pi2))
  185.       (setq cen (polar p1 c r))
  186.       (setq c1 (- (+ c pi) x))
  187.       (setq c2 (+ c pi))
  188.       (vla-addarc *Model-Space* (vlax-3d-point cen) r c1 c2)
  189.     )
  190.   )
  191.   (entlast)
  192. )


本帖子中包含更多资源

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

x
"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

moranyuyan
发表于 2024-7-26 11:40:54 | 显示全部楼层
moranyuyan 发表于 2024-7-22 06:36
命令: 2PARC
; 错误: no function definition: SLMSG

不明白
回复 支持 反对

使用道具 举报

ynhh
发表于 2024-7-25 11:34:53 | 显示全部楼层
Error: no function definition: SLMSG

找不到  MSG

试一下用不成啊


回复 支持 反对

使用道具 举报

尘缘一生
 楼主| 发表于 2024-7-20 21:02:48 | 显示全部楼层
tranque 发表于 2024-7-20 19:52
尘缘前辈最近很高产

最近主要是旧程序在改写，
回复 支持 反对

使用道具 举报

tranque
发表于 2024-7-20 19:52:47 | 显示全部楼层
尘缘前辈最近很高产
回复 支持 反对

使用道具 举报

qazxswk
发表于 2024-7-21 01:00:26 | 显示全部楼层
我感觉我画直线比较多
回复 支持 反对

使用道具 举报

429014673
发表于 2024-7-21 08:39:22 | 显示全部楼层
多是画特定值相切弧，不画任意弧
回复 支持 反对

使用道具 举报

Bao_lai
发表于 2024-7-21 10:43:31 来自手机 | 显示全部楼层
老爷子好诗词，高技术。
回复 支持 反对

使用道具 举报

qazxswk
发表于 2024-7-21 11:09:18 | 显示全部楼层
Bao_lai 发表于 2024-7-21 10:43
老爷子好诗词，高技术。

还老爷子，人家正青春
回复 支持 反对

使用道具 举报

guankuiwu
发表于 2024-7-21 12:15:43 | 显示全部楼层
厉害科啊。666
回复 支持 反对

使用道具 举报

123下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-9-8 08:25 , Processed in 0.246569 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表