|
推荐入门书 是上面说的PDF版本 PDG有缺页 这个是完整版(30个包) 另外两本的地址 http://www.mjtd.com/bbs/dispbbs.asp?boardid=3&replyid=64785&id=61626&page=1&skin=0&Star=5 这个小程序用于选取图中的text实体，计算其数字和：
;;;拾取数字求和
(defun c:pickad (/ ss n totn adn)
(prompt "\n拾取数字求和: ")
(setq ss (ssget '((0 . "TEXT")))
n 0
)
(setq totn 0.0)
(while (setq en (ssname ss n))
(setq adn (atof (cdr (assoc 1 (entget en)))))
(setq totn (+ totn adn))
(setq n (1+ n))
)
(princ (strcat "\n数字和: "))
(princ totn)
(princ)
)
2004-11-25 15:58
2443725 拾取数字和(可作减法) (defun c:pickad1 (/ psub1 ss totn) ;拾取数字和(可作减法) (defun psub1 (ss / tot n en adn) (setq tot 0.0 n 0 ) (while (setq en (ssname ss n)) (setq adn (atof (cdr (assoc 1 (entget en))))) (setq tot (+ tot adn) n (1+ n) ) ) tot ) (prompt "\n拾取数字求差: ") (prompt "\n请先选择被减的数字: ") (setq ss (ssget '((0 . "TEXT"))) totn (psub1 ss) ) (prompt "\n再选择要减去的数字: ") (setq ss (ssget '((0 . "TEXT"))) totn (- totn (psub1 ss)) ) (princ (strcat "\n数字和: ")) (princ totn) (princ) ) 2004-11-25 15:59
2443725
直接修改圆角半径
改变已有的圆角半径：点选圆角弧，输入新半径值，自动重新圆角。
我用它修改过道路转角半径，还算不错：}
;;;MRADIUS.LSP 直接修改FILLET直线半径.
;;;
;;; v0.5 - 1998.1.25
(defun c:mradius( / cget en ent ps1 ps2 e1 e2 r1 r2)
(defun cget(pt siz lnm / ss eout en ent p1 p2 n)
(setq ss
(ssget "c"
(list (- (car pt) siz) (- (cadr pt) siz))
(list (+ (car pt) siz) (+ (cadr pt) siz))
(list '(0 . "LINE") (cons 8 lnm))
)
)
(if ss (progn
(setq n 0)
(while (and (not eout) (setq en (ssname ss n)))
(setq ent (entget en)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent)))
(if (or (equal p1 pt siz) (equal p2 pt siz))
(setq eout en)) ;if
(setq n (1+ n))
)
)) ;if
eout
) ;
(setvar "cmdecho" 0)
(command "undo" "group")
(while (setq en (car (entsel)))
(setq ent (entget en)
o1 (cdr (assoc 10 ent))
lnm (cdr (assoc 8 ent))
r1 (cdr (assoc 40 ent))
a1 (cdr (assoc 50 ent))
a2 (cdr (assoc 51 ent)))
(redraw en 3)
(if (setq ls (getreal (strcat "半径<" (rtos r1 2) ">: ")))
(setq r2 ls))
(redraw en)
; (setq r2 2000.0)
(if (and r2 (/= r2 r1)) (progn
(setq ps1 (polar o1 a1 r1) ps2 (polar o1 a2 r1))
(setq e1 (cget ps1 0.1 lnm) e2 (cget ps2 0.1 lnm))
(if (and e1 e2) (progn
(entdel en)
(setvar "filletrad" r2)
(command "fillet" (list e1 ps1) (list e2 ps2))
)) ;if
)) ;if
)
(command "undo" "end")
(princ)
)
2004-11-25 16:01
2443725 如果你做施工图设计可能会用到标注配件编号，即从某配件上引出一条直线，在直线末端画一个圆圈，在圆圈中表一个编号，以便在材料表中注明配件名称规格等，这个lisp就是做这些的，如果你有用就拿去吧，程序还比较简陋，欢迎高手完善。
(defun biaozhu (/ a1)
(if (or (null r0) (= r0 0)) (setq r0 100))
(if (null h0) (setq h0 100))
(if (or (listp s0) (null s0) (numberp s0) (= s0 "") (not (tblsearch "style" s0))) (setq s0 (getvar "textstyle")))
(if (or (listp text0) (null text0) (= text0 "")) (setq text0 "00"))
(setq a1 T)
(while a1(princ "The current Radius is <")
(princ r0)
(princ (strcat "> The current Text-style is <" s0 ">" "\nThe current Text-high is <"))
(princ h0)
(princ ">")
(initget "circle-Radius text-Stytle text-High Text")
(setq a1 (getpoint "\ncircle-Radius/text-Stytle/text-High/Text/<startpoint>:"))
(if a1
(cond ((= a1 "circle-Radius") (cradius))
((= a1 "text-Stytle") (tstytle))
((= a1 "text-High") (thigh))
((= a1 "Text") (textx))
(T (drawline))
)
(setq a1 nil)
)
)
)
2004-11-25 16:02
2443725 一个螺旋线的
程序有一个小功能：记忆上次输入的数据。这样会方便很多。
(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)
)
2004-11-25 16:03
2443725 点选实体进行绘制。 这个程序基于这样的想法：
作图的时候，要作的对象在图中已有同类的实体，则点取这个同类的实体，程序根据其类型调用相应的绘制命令。
更有意义的是：程序会自动匹配颜色、线形、图层等参数，省去了许多转换操作。 LCMD.LSP
;;;
;;;
(defun c:lcmd( / ss en nl nc nlt ladd n cc ent nthk ntp)
(setvar "cmdecho" 0) ;;;主程序
(setq en (entsel "\n请选择目标实体: "))
(if en (progn
(setq eent (entget (car en))
ntp (cdr (assoc 0 eent))
nc (cdr (assoc 62 eent)) ;颜色
nlt (cdr (assoc 6 eent)) ;线型
nl (cdr (assoc 8 eent)) ;层
nthk (cdr (assoc 39 eent)) ;厚度
nelv (caddr (trans (cdr (assoc 10 eent)) 0 1)) ;高度
)
(if nc (setvar "cecolor" nc) (setvar "cecolor" "bylayer"))
(if nlt (setvar "celtype" nlt) (setvar "celtype" "bylayer"))
(setvar "clayer" nl)
(cond
((= ntp "LINE") (command "line"))
((= ntp "POLYLINE") (command "pline"))
((= ntp "ARC") (command "arc"))
((= ntp "3DFACE") (command "3dface"))
((= ntp "SOLID") (command "solid"))
((= ntp "INSERT") (command "insert"))
((= ntp "CIRCLE") (command "circle"))
((= ntp "TEXT")
(setvar "textstyle" (cdr (assoc 7 eent)))
(setvar "textsize" (cdr (assoc 40 eent)))
(command "text")
)
((= ntp "DIMENSION")
)
((= ntp "INSERT")
(setq nin (cdr (assoc 2 eent)))
(setvar "isname" nin)
(command "insert")
)
(t)
) ;cond
) ;progn
) ;if
(princ)
)
| 
[复制链接]
楼主
显身卡
发表于 2007-9-25 09:26:00