nonsmall
发表于 2007-9-24 09:28:00
<p>推荐入门书 是上面说的PDF版本 PDG有缺页 这个是完整版(30个包)</p><p></p><p>另外两本的地址</p><p><a href="http://www.mjtd.com/bbs/dispbbs.asp?boardid=3&replyid=64785&id=61626&page=1&skin=0&Star=5">http://www.mjtd.com/bbs/dispbbs.asp?boardid=3&replyid=64785&id=61626&page=1&skin=0&Star=5</a></p><p></p><p>这个小程序用于选取图中的text实体，计算其数字和：<br/>;;;拾取数字求和 <br/>(defun c:pickad (/ ss n totn adn)<br/> (prompt "\n拾取数字求和: ")<br/> (setq ss (ssget '((0 . "TEXT")))<br/> n 0<br/> )<br/> (setq totn 0.0)<br/> (while (setq en (ssname ss n))<br/> (setq adn (atof (cdr (assoc 1 (entget en)))))<br/> (setq totn (+ totn adn))<br/> (setq n (1+ n))<br/> )<br/> (princ (strcat "\n数字和: "))<br/> (princ totn)<br/> (princ)<br/>)<br/></p><div class="subtable altbg1">2004-11-25 15:58<br/> <b>2443725</b></div><div class="subtable altbg2 t_msg" style="WIDTH: auto; HEIGHT: auto;">拾取数字和(可作减法)<br/>(defun c:pickad1 (/ psub1 ss totn) <br/>;拾取数字和(可作减法)<br/> (defun psub1 (ss / tot n en adn)<br/> (setq tot 0.0<br/> n 0<br/> )<br/> (while (setq en (ssname ss n))<br/> (setq adn (atof (cdr (assoc 1 (entget en)))))<br/> (setq tot (+ tot adn)<br/> n (1+ n)<br/> )<br/> )<br/> tot<br/> )<br/><br/> (prompt "\n拾取数字求差: ")<br/> (prompt "\n请先选择被减的数字: ")<br/> (setq ss (ssget '((0 . "TEXT")))<br/> totn (psub1 ss)<br/> )<br/> (prompt "\n再选择要减去的数字: ")<br/> (setq ss (ssget '((0 . "TEXT")))<br/> totn (- totn (psub1 ss))<br/> )<br/> (princ (strcat "\n数字和: "))<br/> (princ totn)<br/> (princ)<br/>)<br/><div class="subtable altbg1">2004-11-25 15:59<br/> <b>2443725<br/></b>直接修改圆角半径<br/>改变已有的圆角半径：点选圆角弧，输入新半径值，自动重新圆角。<br/>我用它修改过道路转角半径，还算不错：}<br/>;;;MRADIUS.LSP 直接修改FILLET直线半径.<br/>;;;<br/>;;; v0.5 - 1998.1.25<br/>(defun c:mradius( / cget en ent ps1 ps2 e1 e2 r1 r2)<br/> (defun cget(pt siz lnm / ss eout en ent p1 p2 n)<br/> (setq ss <br/> (ssget "c" <br/> (list (- (car pt) siz) (- (cadr pt) siz))<br/> (list (+ (car pt) siz) (+ (cadr pt) siz))<br/> (list '(0 . "LINE") (cons 8 lnm))<br/> )<br/> )<br/> (if ss (progn<br/> (setq n 0)<br/> (while (and (not eout) (setq en (ssname ss n)))<br/> (setq ent (entget en)<br/> p1 (cdr (assoc 10 ent))<br/> p2 (cdr (assoc 11 ent)))<br/> (if (or (equal p1 pt siz) (equal p2 pt siz))<br/> (setq eout en)) ;if<br/> (setq n (1+ n))<br/> )<br/> )) ;if<br/> eout<br/> ) ;<br/> (setvar "cmdecho" 0)<br/> (command "undo" "group")<br/>(while (setq en (car (entsel)))<br/> (setq ent (entget en)<br/> o1 (cdr (assoc 10 ent))<br/> lnm (cdr (assoc 8 ent))<br/> r1 (cdr (assoc 40 ent))<br/> a1 (cdr (assoc 50 ent))<br/> a2 (cdr (assoc 51 ent)))<br/> (redraw en 3)<br/> (if (setq ls (getreal (strcat "半径<" (rtos r1 2) ">: ")))<br/> (setq r2 ls))<br/> (redraw en)<br/>; (setq r2 2000.0)<br/> (if (and r2 (/= r2 r1)) (progn<br/> (setq ps1 (polar o1 a1 r1) ps2 (polar o1 a2 r1))<br/> (setq e1 (cget ps1 0.1 lnm) e2 (cget ps2 0.1 lnm))<br/> (if (and e1 e2) (progn<br/> (entdel en)<br/> (setvar "filletrad" r2)<br/> (command "fillet" (list e1 ps1) (list e2 ps2))<br/> )) ;if<br/> )) ;if<br/>)<br/> (command "undo" "end")<br/> (princ)<br/>)<br/></div></div><div class="subtable altbg1">2004-11-25 16:01<br/> <b>2443725</b></div><div class="subtable altbg2 t_msg" style="WIDTH: auto; HEIGHT: auto;">如果你做施工图设计可能会用到标注配件编号，即从某配件上引出一条直线，在直线末端画一个圆圈，在圆圈中表一个编号，以便在材料表中注明配件名称规格等，这个<b style="COLOR: black; BACKGROUND-COLOR: #ffff66;">lisp</b>就是做这些的，如果你有用就拿去吧，程序还比较简陋，欢迎高手完善。<br/>(defun biaozhu (/ a1)<br/> (if (or (null r0) (= r0 0)) (setq r0 100))<br/> (if (null h0) (setq h0 100))<br/> (if (or (listp s0) (null s0) (numberp s0) (= s0 "") (not (tblsearch "style" s0))) (setq s0 (getvar "textstyle")))<br/> (if (or (listp text0) (null text0) (= text0 "")) (setq text0 "00"))<br/> (setq a1 T)<br/> (while a1(princ "The current Radius is <")<br/> (princ r0)<br/> (princ (strcat "> The current Text-style is <" s0 ">" "\nThe current Text-high is <"))<br/> (princ h0)<br/> (princ ">")<br/> (initget "circle-Radius text-Stytle text-High Text")<br/> (setq a1 (getpoint "\ncircle-Radius/text-Stytle/text-High/Text/<startpoint>:"))<br/> <br/> (if a1<br/> (cond ((= a1 "circle-Radius") (cradius))<br/> ((= a1 "text-Stytle") (tstytle))<br/> ((= a1 "text-High") (thigh))<br/> ((= a1 "Text") (textx))<br/> (T (drawline))<br/> )<br/> (setq a1 nil)<br/> )<br/> )<br/>)<br/></div><br/><div class="subtable altbg1">2004-11-25 16:02<br/> <b>2443725</b></div><div class="subtable altbg2 t_msg" style="WIDTH: auto; HEIGHT: auto;">一个螺旋线的 <br/>程序有一个小功能：记忆上次输入的数据。这样会方便很多。<br/>(defun c:rol1( / r1 r2 high hi stps p0 p1 p2 ang i hia)<br/> (command "undo" "group")<br/> (princ "\n绘制弹簧线....")<br/> (or #rol1_dat (setq #rol1_dat '(1000.0 3000.0 72 24)))<br/> (mapcar 'set '(r1 high stps stpp) #rol1_dat)<br/> (if (setq ls (getint (strcat "\n每圈步数&lt;" (itoa stpp) "&gt;: "))) (setq stpp ls))<br/> (setq ctr (getpoint "\n起点圆心: "))<br/> (if (setq ls (getdist ctr (strcat "\n半径&lt;" (rtos r1 2 2) "&gt;: "))) (setq r1 ls))<br/> (if (setq ls (getdist ctr (strcat "\n螺距&lt;" (rtos high 2 2) "&gt;: "))) (setq high ls))<br/> (if (setq ls (getint (strcat "\n总步数&lt;" (itoa stps) "&gt;: "))) (setq stps ls))<br/> (setq ang 0<br/> p1 (polar ctr ang r1)<br/> hia (/ high stpp)<br/> i 0)<br/> (command "3dpoly" p1)<br/> (repeat stps<br/> (setq ang (+ ang (/ pi 12.0))<br/> i (1+ i)<br/> hi (* i hia))<br/> (command (mapcar '+ (polar ctr ang r1) (list 0 0 (* i hia))))<br/> ) ;repeat<br/> (command "") <br/> (setq #rol1_dat (list r1 high stps stpp))<br/> (command "undo" "end")<br/> (princ)<br/>)</div><br/><br/><div class="subtable altbg1">2004-11-25 16:03<br/> <b>2443725</b></div><div class="subtable altbg2 t_msg" style="WIDTH: auto; HEIGHT: auto;">点选实体进行绘制。</div><div class="subtable altbg2 t_msg" style="WIDTH: auto; HEIGHT: auto;">这个程序基于这样的想法：<br/>作图的时候，要作的对象在图中已有同类的实体，则点取这个同类的实体，程序根据其类型调用相应的绘制命令。<br/>更有意义的是：程序会自动匹配颜色、线形、图层等参数，省去了许多转换操作。</div><div class="subtable altbg2 t_msg" style="WIDTH: auto; HEIGHT: auto;">LCMD.LSP<br/>;;;<br/>;;;<br/>(defun c:lcmd( / ss en nl nc nlt ladd n cc ent nthk ntp)<br/> (setvar "cmdecho" 0) </div><div class="subtable altbg2 t_msg" style="WIDTH: auto; HEIGHT: auto;">;;;主程序<br/> (setq en (entsel "\n请选择目标实体: "))<br/> (if en (progn<br/> (setq eent (entget (car en))<br/> ntp (cdr (assoc 0 eent))<br/> nc (cdr (assoc 62 eent)) ;颜色<br/> nlt (cdr (assoc 6 eent)) ;线型 <br/> nl (cdr (assoc 8 eent)) ;层<br/> nthk (cdr (assoc 39 eent)) ;厚度<br/> nelv (caddr (trans (cdr (assoc 10 eent)) 0 1)) ;高度<br/> )<br/> (if nc (setvar "cecolor" nc) (setvar "cecolor" "bylayer"))<br/> (if nlt (setvar "celtype" nlt) (setvar "celtype" "bylayer"))<br/> (setvar "clayer" nl)<br/> (cond<br/> ((= ntp "LINE") (command "line"))<br/> ((= ntp "POLYLINE") (command "pline"))<br/> ((= ntp "ARC") (command "arc"))<br/> ((= ntp "3DFACE") (command "3dface"))<br/> ((= ntp "SOLID") (command "solid"))<br/> ((= ntp "INSERT") (command "insert"))<br/> ((= ntp "CIRCLE") (command "circle"))<br/> ((= ntp "TEXT")<br/> (setvar "textstyle" (cdr (assoc 7 eent)))<br/> (setvar "textsize" (cdr (assoc 40 eent)))<br/> (command "text")<br/> )<br/> ((= ntp "DIMENSION")<br/> )<br/> ((= ntp "INSERT")<br/> (setq nin (cdr (assoc 2 eent)))<br/> (setvar "isname" nin)<br/> (command "insert")<br/> )<br/> (t)<br/> ) ;cond<br/> ) ;progn<br/> ) ;if<br/> (princ)<br/>)</div><br/>
mingvictor
发表于 2007-9-25 09:26:00
楼主，劳苦功高啊！谢谢先！正是有了像楼主这样的人！我的坛子才会比别的坛子人气好啊！
YDPLDL
发表于 2007-10-4 15:23:00
多谢楼主,顶一下.
zhongzilei
发表于 2007-10-5 15:40:00
<p>好资料，正要好好学学lisp，目前也只是一知半解</p><p></p>
vkzhang
发表于 2007-10-12 14:16:00
<p>支持一下</p><p></p>
lu_618
发表于 2007-10-14 15:49:00
<p>谢谢有这么多的资料可以下载，顶一下，哈哈</p>
lsclover
发表于 2007-10-16 22:57:00
谢谢！！辛苦了！！！
wb1108
发表于 2007-10-19 21:32:00
<p>谢谢，新手，学习学习</p>
pepsi04
发表于 2007-10-23 21:56:00
ddd
wgg1209
发表于 2007-11-17 16:23:00
太有才了，搂住真牛
页:
1
2
[3]
4
5
6
7
8
9
10
11
12