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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 开新帖继续求弯头的完善LISP
返回列表 发新帖
查看: 1783|回复: 4

[提问] 开新帖继续求弯头的完善LISP

[复制链接]
konoko
发表于 2013-5-18 09:45:07 | 显示全部楼层 |阅读模式
首先谢谢smartstar的弯头程式，点选方向的方法很特别。但也不太稳定。。 希望能高人指定修改成直接内弯生成弯头。真的很需要！请大大们帮忙，谢谢！



弯头, 风管

本帖子中包含更多资源

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

x

相关帖子
回复

使用道具 举报

konoko
 楼主| 发表于 2013-5-18 09:46:22 | 显示全部楼层
  2. (defun c:df1 (/   ip1 ip2 ip3 la  a   co  e   a1  d1  d2  d3  dn  p
  3.        li  l1  l2  l3  l4  l5  l6  lt  i   m1  n1  m2  n2  m3
  4.        n3  r   f   a   b   c   x   y   z
  5.       )
  6.   (setvar "cmdecho" 0)
  7.   (setq a (ssget))
  8.   (setq n (sslength a))
  9.   (cond ((= n 6)
  10.   (setq i 1)
  11.   (setq pt0 (getpoint "请选择倒角方向点:"))
  12.   (setq p (trans pt0 1 0))
  13.   (setq d1 (dis (ssname a 0)))
  14.   (setq a1 (ang (ssname a 0)))
  15.   (setq m1 0
  16.         n1 100
  17.         m2 100
  18.         n2 100
  19.         m3 100
  20.         n3 100
  21.   )
  22.   (repeat 5
  23.     (sort i)
  24.     (setq i (1+ i))
  25.   )
  26.   (setq l1 (ssname a m1))
  27.   (setq l2 (ssname a n1))
  28.   (setq l3 (ssname a m2))
  29.   (setq l4 (ssname a n2))
  30.   (setq l5 (ssname a m3))
  31.   (setq l6 (ssname a n3))
  32.   (setq la (cdr (assoc 8 (entget l1))))
  33.   (setq co (cdr (assoc 62 (entget l1))))
  34.   (setq lt (cdr (assoc 6 (entget l1))))
  35.   (setq a (cdr (assoc 10 (entget l1))))
  36.   (setq b (cdr (assoc 11 (entget l1))))
  37.   (setq c (cdr (assoc 10 (entget l5))))
  38.   (setq x (cdr (assoc 10 (entget l2))))
  39.   (setq y (cdr (assoc 11 (entget l2))))
  40.   (setq z (cdr (assoc 10 (entget l6))))
  41.   (setq ip1 (pinter l1 l2))
  42.   (setq ip2 (pinter l3 l4))
  43.   (setq ip3 (pinter l5 l6))
  44.   (setq
  45.     d1 (abs (* (sin (- (angle a b) (angle a c))) (distance a c)))
  46.   )
  47.   (setq
  48.     d2 (abs (* (sin (- (angle x y) (angle x z))) (distance x z)))
  49.   )
  50.   (if (<= d1 d2)
  51.     (setq r1 (/ d1 3))
  52.     (setq r1 (/ d2 3))
  53.   )
  54.   (setq
  55.     r
  56.      (getdist (strcat "\n请输入倒角半径<" (rtos r1 2)">:")
  57.      )
  58.   )
  59.   (if (= r nil)
  60.     (setq r r1)
  61.   )
  62.   (lu l1 ip1)
  63.   (lu l2 ip1)
  64.   (lu l3 ip2)
  65.   (lu l4 ip2)
  66.   (lu l5 ip3)
  67.   (lu l6 ip3)
  68.   (if (<= d1 d2)
  69.     (progn
  70.       (setq d3 (+ (/ d1 2) r))
  71.       (setq f (+ d1 r))
  72.     )
  73.     (progn
  74.       (setq d3 (+ (/ d2 2) r))
  75.       (setq f (+ d2 r))
  76.     )
  77.   )
  78.   (setvar "filletrad" r)
  79.   (command "fillet" l1 l2)
  80.   (setq j (entget (entlast)))
  81.   (setvar "filletrad" d3)
  82.   (command "fillet" l3 l4)
  83.   (setvar "filletrad" f)
  84.   (command "fillet" l5 l6)
  85.   (setq k (entget (entlast)))
  86.   (command "line"
  87.     (trans (polar (cdr (assoc 10 j))
  88.     (cdr (assoc 50 j))
  89.     (cdr (assoc 40 j))
  90.     )
  91.     0
  92.     1
  93.     )
  94.     (trans (polar (cdr (assoc 10 k))
  95.     (cdr (assoc 50 k))
  96.     (cdr (assoc 40 k))
  97.     )
  98.     0
  99.     1
  100.     )
  101.     ""
  102.   )
  103.   (setq li (ssadd))
  104.   (setq li (ssadd (entlast) li))
  105.   (command "line"
  106.     (trans (polar (cdr (assoc 10 j))
  107.     (cdr (assoc 51 j))
  108.     (cdr (assoc 40 j))
  109.     )
  110.     0
  111.     1
  112.     )
  113.     (trans (polar (cdr (assoc 10 k))
  114.     (cdr (assoc 51 k))
  115.     (cdr (assoc 40 k))
  116.     )
  117.     0
  118.     1
  119.     )
  120.     ""
  121.   )
  122.   (setq li (ssadd (entlast) li))
  123.   (COMMAND "chprop" li "" "la" la "")
  124.   (if (= co nil)
  125.     (command "chprop" li "" "c" "bylayer" "")
  126.     (command "chprop" li "" "c" co "")
  127.   )
  128.   (if (= lt nil)
  129.     (command "chprop" li "" "lt" "bylayer" "")
  130.     (command "chprop" li "" "lt" lt "")
  131.   )
  132. )
  133. ((= n 4)
  134.   (setq i 1)
  135.   (setq pt0 (getpoint "请选择倒角方向点:"))
  136.   (setq p (trans pt0 1 0))
  137.   (setq d1 (dis (ssname a 0)))
  138.   (setq a1 (ang (ssname a 0)))
  139.   (setq m1 0
  140.         n1 100
  141.         m2 100
  142.         n2 100
  143.   )
  144.   (repeat 3
  145.     (sort i)
  146.     (setq i (1+ i))
  147.   )
  148.   (setq l1 (ssname a m1))
  149.   (setq l2 (ssname a n1))
  150.   (setq l3 (ssname a m2))
  151.   (setq l4 (ssname a n2))
  152.   (setq la (cdr (assoc 8 (entget l1))))
  153.   (setq co (cdr (assoc 62 (entget l1))))
  154.   (setq lt (cdr (assoc 6 (entget l1))))
  155.   (setq a (cdr (assoc 10 (entget l1))))
  156.   (setq b (cdr (assoc 11 (entget l1))))
  157.   (setq c (cdr (assoc 10 (entget l3))))
  158.   (setq x (cdr (assoc 10 (entget l2))))
  159.   (setq y (cdr (assoc 11 (entget l2))))
  160.   (setq z (cdr (assoc 10 (entget l4))))
  161.   (setq ip1 (pinter l1 l2))
  162.   (setq ip2 (pinter l3 l4))
  163.   (setq
  164.     d1 (abs (* (sin (- (angle a b) (angle a c))) (distance a c)))
  165.   )
  166.   (setq
  167.     d2 (abs (* (sin (- (angle x y) (angle x z))) (distance x z)))
  168.   )
  169.   (if (<= d1 d2)
  170.     (setq r1 (/ d1 3))
  171.     (setq r1 (/ d2 3))
  172.   )
  173.   (setq
  174.     r
  175.      (getdist (strcat "\n请输入倒角半径<" (rtos r1 2)">:")
  176.      )
  177.   )
  178.   (if (= r nil)
  179.     (setq r r1)
  180.   )
  181.   (lu l1 ip1)
  182.   (lu l2 ip1)
  183.   (lu l3 ip2)
  184.   (lu l4 ip2)
  185.   (if (<= d1 d2)
  186.     (setq f (+ d1 r))
  187.     (setq f (+ d2 r))
  188.   )
  189.   (setvar "filletrad" r)
  190.   (command "fillet" l1 l2)
  191.   (setq j (entget (entlast)))
  192.   (setvar "filletrad" f)
  193.   (command "fillet" l3 l4)
  194.   (setq k (entget (entlast)))
  195.   (command "line"
  196.     (trans (polar (cdr (assoc 10 j))
  197.     (cdr (assoc 50 j))
  198.     (cdr (assoc 40 j))
  199.     )
  200.     0
  201.     1
  202.     )
  203.     (trans (polar (cdr (assoc 10 k))
  204.     (cdr (assoc 50 k))
  205.     (cdr (assoc 40 k))
  206.     )
  207.     0
  208.     1
  209.     )
  210.     ""
  211.   )
  212.   (setq li (ssadd))
  213.   (setq li (ssadd (entlast) li))
  214.   (command "line"
  215.     (trans (polar (cdr (assoc 10 j))
  216.     (cdr (assoc 51 j))
  217.     (cdr (assoc 40 j))
  218.     )
  219.     0
  220.     1
  221.     )
  222.     (trans (polar (cdr (assoc 10 k))
  223.     (cdr (assoc 51 k))
  224.     (cdr (assoc 40 k))
  225.     )
  226.     0
  227.     1
  228.     )
  229.     ""
  230.   )
  231.   (setq li (ssadd (entlast) li))
  232.   (COMMAND "chprop" li "" "la" la "")
  233.   (if (= co nil)
  234.     (command "chprop" li "" "c" "bylayer" "")
  235.     (command "chprop" li "" "c" co "")
  236.   )
  237.   (if (= lt nil)
  238.     (command "chprop" li "" "lt" "bylayer" "")
  239.     (command "chprop" li "" "lt" lt "")
  240.   )
  241. )
  242. (t (princ "\n选择的线数目不对"))
  243.   )
  244.   (princ)
  245. )
  246. (defun sort(i / ai e de)
  247.   (setq e (ssname a i))
  248.   (setq ai (ang e))
  249.   (setq de (dis e))
  250.   (if (or (equal ai a1 0.1) (equal ai (- pi a1) 0.1))
  251.       (if (< d1 de)
  252.           (if (< m2 100)
  253.               (if (< (dis (ssname a m2)) de)
  254.                   (setq m3 i)
  255.                   (progn (setq m3 m2)
  256.                          (setq m2 i)
  257.                   )
  258.               )
  259.               (setq m2 i)
  260.           )
  261.           (progn (setq d1 de)
  262.                  (setq m3 m2)
  263.                  (setq m2 m1)
  264.                  (setq m1 i)
  265.           )
  266.       )
  267.       (if (< n1 100)
  268.           (if (< dn de)
  269.               (if (< n2 100)
  270.                   (if (< (dis (ssname a n2)) de)
  271.                       (setq n3 i)
  272.                       (progn (setq n3 n2)
  273.                              (setq n2 i)
  274.                       )
  275.                   )
  276.                   (setq n2 i)
  277.               )
  278.               (progn (setq dn de)
  279.                      (setq n3 n2)
  280.                      (setq n2 n1)
  281.                      (setq n1 i)
  282.               )
  283.           )
  284.           (progn (setq n1 i)
  285.                  (setq dn de)
  286.           )
  287.       )
  288. )
  289. )

  291. (defun dis(a / pa pb)
  292.   (setq pa (cdr (assoc 10 (entget a))))
  293.   (setq pb (cdr (assoc 11 (entget a))))
  294.   (abs (* (sin (- (angle pa pb) (angle pa p))) (distance pa p)))
  295. )
  296. (defun pinter(l1 l2 / ip)
  297.   (setq ip (inters (cdr (assoc 10 (entget l1))) (cdr (assoc 11 (entget l1))) (cdr (assoc 10 (entget l2))) (cdr (assoc 11 (entget l2))) nil))
  298. )
  299. (defun lu(l ip / j k pa pb ang ang1 ang2)
  300.   (setq j (entget l))
  301.   (setq pa (cdr (assoc 10 j)))
  302.   (setq pb (cdr (assoc 11 j)))
  303.   (setq ang1 (angle pa pb))
  304.   (setq ang2 (angle p ip))
  305.   (setq ang (abs (- ang1 ang2)))
  306.   (if (or (< ang (/ pi 2)) (> ang (* pi 1.5)))
  307.       (setq k (subst (cons 11 ip) (assoc 11 j) j))
  308.       (setq k (subst (cons 10 ip) (assoc 10 j) j))
  309.   )
  310.   (entmod k)
  311. )

  313. (defun ang (a / pa pb)
  314.   (setq pa (cdr (assoc 10 (entget a))))
  315.   (setq pb (cdr (assoc 11 (entget a))))
  316.   (rem (angle pa pb) pi)
  317. )
回复 支持 反对

使用道具 举报

konoko
 楼主| 发表于 2013-5-19 10:03:32 来自手机 | 显示全部楼层
继续顶帖。。。
回复 支持 反对

使用道具 举报

吃饭饭长胖胖
发表于 2013-5-19 19:31:00 | 显示全部楼层
我看不懂这个lsp里面 if n=6之后是干嘛的，n=4的能看懂
回复 支持 反对

使用道具 举报

Flamingo
发表于 2021-12-4 20:48:00 | 显示全部楼层
我写了一个类似的看我的帖子

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-15 07:17 , Processed in 0.188142 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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