[推荐]：有用的lisp小工具集合

arja · 发表于 2004-4-21 10:27:31

能不能来一个螺旋线的

841594 · 发表于 2004-4-21 18:27:26

最初由 arja 发布
[B]能不能来一个螺旋线的 [/B]

这个以前也编过，今天顺便整理了一下：
程序有一个小功能：记忆上次输入的数据。这样会方便很多。

[FONT=courier new]
(defun c:rol1( / r1 r2 high hi stps p0 p1 p2 ang i hia)
(command "undo" "group")
(princ "\n绘制弹簧线....")
(or #rol1_dat (setq #rol1_dat '(1000.0 3000.0 72 24)))
(mapcar 'set '(r1 high stps stpp) #rol1_dat)
(if (setq ls (getint (strcat "\n每圈步数<" (itoa stpp) ">: "))) (setq stpp ls))
(setq ctr (getpoint "\n起点圆心: "))
(if (setq ls (getdist ctr (strcat "\n半径<" (rtos r1 2 2) ">: "))) (setq r1 ls))
(if (setq ls (getdist ctr (strcat "\n螺距<" (rtos high 2 2) ">: "))) (setq high ls))
(if (setq ls (getint (strcat "\n总步数<" (itoa stps) ">: "))) (setq stps ls))
(setq ang 0
p1 (polar ctr ang r1)
hia (/ high stpp)
i 0)
(command "3dpoly" p1)
(repeat stps
(setq ang (+ ang (/ pi 12.0))
i (1+ i)
hi (* i hia))
(command (mapcar '+ (polar ctr ang r1) (list 0 0 (* i hia))))
) ;repeat
(command "")
(setq #rol1_dat (list r1 high stps stpp))
(command "undo" "end")
(princ)
)
[/FONT]

[FONT=courier new] 
(defun c:rol1( / r1 r2 high hi stps p0 p1 p2 ang i hia) 
  (command "undo" "group") 
  (princ "\n绘制弹簧线....") 
  (or #rol1_dat (setq #rol1_dat '(1000.0 3000.0 72 24))) 
  (mapcar 'set '(r1 high stps stpp) #rol1_dat) 
  (if (setq ls (getint (strcat "\n每圈步数<" (itoa stpp) ">: "))) (setq stpp ls)) 
  (setq ctr (getpoint "\n起点圆心: ")) 
  (if (setq ls (getdist ctr (strcat "\n半径<" (rtos r1 2 2) ">: "))) (setq r1 ls)) 
  (if (setq ls (getdist ctr (strcat "\n螺距<" (rtos high 2 2) ">: "))) (setq high ls)) 
  (if (setq ls (getint (strcat "\n总步数<" (itoa stps) ">: "))) (setq stps ls)) 
  (setq ang 0 
        p1 (polar ctr ang r1) 
        hia (/ high stpp) 
        i 0) 
  (command "3dpoly" p1) 
  (repeat stps 
    (setq ang (+ ang (/ pi 12.0)) 
          i (1+ i) 
          hi (* i hia)) 
    (command (mapcar '+ (polar ctr ang r1) (list 0 0 (* i hia)))) 
  ) ;repeat 
  (command "")   
  (setq #rol1_dat (list r1 high stps stpp)) 
  (command "undo" "end") 
  (princ) 
) 
  [/FONT]

ywr126 · 发表于 2004-4-21 22:03:23

下载时要求的币太多新人太可怜啊

buba · 发表于 2004-5-18 04:01:40

用的时候要注意,MT写的字不能计算

xxxyzxx · 发表于 2004-6-11 20:22:44

呵呵，还是楼主贴的好，晓东的我不会使快捷，制图速度不爽，太感谢楼主了（由此贴学到了不少知识！）

iamkali · 发表于 2004-6-14 22:47:14

呵呵,看了各位兄弟姐妹的lisp,既感到高兴,有感到惭愧,高兴的是有好东西用,惭愧的是自己对这方面一窍不通.

hqs_2 · 发表于 2004-7-14 22:24:48

我想下载看看

hsb-hy · 发表于 2004-7-24 19:29:06

我好久没有回帖了！这里的东西真是多，下了一些，比较实用！

841594 · 发表于 2004-7-25 10:13:06

这个多年前编的小程序在画立面的时候可能有所帮助。

[FONT=courier new]
;制弧状投影线
(defun c:lll( / lis1 lis2 bn blkname en1 en2 n ent1 ent2
p11 p12 p21 p22 l1 l2
ang1 ang2 ang an1 ss)
(setq bn 0 blkname (strcat "rd-" (itoa bn)))
(while (tblsearch "BLOCK" blkname)
(setq bn (1+ bn) blkname (strcat "rd-" (itoa bn)))
) ;while
(setq en1 (car (entsel "\n第一根边线: "))
en2 (car (entsel "\n第二根边线: "))
n (if (setq ls (getint "\n投影线根数: ")) ls 4))
(setq ent1 (entget en1)
ent2 (entget en2)
p11 (cdr (assoc 10 ent1))
p12 (cdr (assoc 11 ent1))
p21 (cdr (assoc 10 ent2))
p22 (cdr (assoc 11 ent2)))
(if (inters p11 p21 p12 p22 t) (setq pb p21 p21 p22 p22 p21))
(setq l1 (distance p11 p12)
l2 (distance p21 p22)
ang1 (angle p11 p12)
ang2 (angle p21 p22))
(setq an1 (/ pi 2.0 n) ang 0 ss (ssadd))
(repeat (1+ n)
(command "line"
"none"
(polar p11 ang1 (* l1 (sin ang)))
"none"
(polar p21 ang2 (* l2 (sin ang)))
"" )
(ssadd (entlast) ss)
(setq ang (+ ang an1))
)
;;; (command "chprop" ss "" "c" "byblock" "")
(command "block" blkname p11 ss "")
(command "insert" blkname p11 1.0 1.0 0)
(princ)
)
[/FONT]

[FONT=courier new] 
;制弧状投影线 
 
(defun c:lll( / lis1 lis2 bn blkname en1 en2 n ent1 ent2 
                p11 p12 p21 p22 l1 l2 
                ang1 ang2 ang an1 ss) 
  (setq bn 0 blkname (strcat "rd-" (itoa bn))) 
  (while (tblsearch "BLOCK" blkname) 
    (setq bn (1+ bn) blkname (strcat "rd-" (itoa bn))) 
  ) ;while 
  (setq en1 (car (entsel "\n第一根边线: ")) 
        en2 (car (entsel "\n第二根边线: ")) 
        n (if (setq ls (getint "\n投影线根数: ")) ls 4)) 
  (setq ent1 (entget en1) 
        ent2 (entget en2) 
        p11 (cdr (assoc 10 ent1)) 
        p12 (cdr (assoc 11 ent1)) 
        p21 (cdr (assoc 10 ent2)) 
        p22 (cdr (assoc 11 ent2))) 
  (if (inters p11 p21 p12 p22 t) (setq pb p21 p21 p22 p22 p21)) 
  (setq l1 (distance p11 p12) 
        l2 (distance p21 p22) 
        ang1 (angle p11 p12) 
        ang2 (angle p21 p22)) 
  (setq an1 (/ pi 2.0 n) ang 0 ss (ssadd)) 
  (repeat (1+ n) 
    (command "line" 
             "none" 
       (polar p11 ang1 (* l1 (sin ang))) 
             "none" 
       (polar p21 ang2 (* l2 (sin ang))) 
       "" ) 
    (ssadd (entlast) ss) 
    (setq ang (+ ang an1)) 
  ) 
;;;  (command "chprop" ss "" "c" "byblock" "") 
  (command "block" blkname p11 ss "") 
  (command "insert" blkname p11 1.0 1.0 0) 
  (princ) 
) 
 
  [/FONT]

yeh8001 · 发表于 2004-8-23 15:56:19

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

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

×

我现在没钱啊，不能下啊

青柚 · 发表于 2004-9-2 15:11:34

很不错，至少我是这么认为，加油！

dsk · 发表于 2004-10-4 22:47:15

最初由 841594 发布
[B]我继续贴：
改变已有的圆角半径：点选圆角弧，输入新半径值，自动重新圆角。
我用它修改过道路转角半径，还算不错：} [/B]

请问大侠如何一次可以选择多个圆角一起修改

DYWU · 发表于 2004-10-11 09:44:21

能否批量选

pxt2001 · 发表于 2004-10-14 13:23:48

最初由 manchu 发布
[B]我也来凑个热闹，如果你做施工图设计可能会用到标注配件编号，即从某配件上引出一条直线，在直线末端画一个圆圈，在圆圈中表一个编号，以便在材料表中注明配件名称规格等，这个lisp就是做这些的，如果你有用就拿去吧... [/B]

感谢这位大侠,这个lisp在做材料表时好用,在给结构大样钢筋编号时也很实用.

zhangyihhh · 发表于 2004-10-25 08:05:09

呵呵，很有使用价值啊

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

[推荐]：有用的lisp小工具集合

画弧形投影线的小程序

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

相关帖子

Re: [日积月累]：有用的lisp小工具（7）--直接修改圆角半径