求助飞哥

yaohui

飞哥：能给我找个作图的lisp程序吗？比较简单得就行了，比如说一个轴、螺母等。谢谢你。上次你告我，我没找到合适的，都是动画的啊。

meflying

你想做什么呢？ 简单的： (defun c:test() (command "_.line" '(0 0 0) '(100 200 0) "") (princ) ) 复杂的，命令：shaft2 (vl-load-com)
(defun loadline(lname / adoc msp ltps lname)
;(setq lname (getstring "输入需要添加的线型:"))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq ltps (vla-get-linetypes adoc))
(setq ltp (vl-catch-all-apply 'vla-load (list ltps lname "acadiso.lin")))
(if (vl-catch-all-error-p ltp)
;(princ "此线型已存在！")
(princ)
)
(princ)
) (defun Newlayer(lname lcolor lin / layer layers adoc)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq layers (vla-get-layers adoc))
(setq layer (vl-catch-all-apply 'vla-item (list layers lname)))
(if (vl-catch-all-error-p layer)
(progn
(setq layer (vla-add layers lname))
(vla-put-color layer lcolor)
)
)
(vla-put-ActiveLayer adoc layer)
(if lin
(vla-put-linetype layer lin)
)
(princ)
)
;;;;;;;以上两个函数是加载线型和图层的，可以用(command "_.layer" ...)代替
(defun DrawCircle(para_list ptLeftCenter / n i d ds m pt1 pt2 pt3 pt4)
(setq n (length para_list))
(setq i (1- n))
(while (>= i 0)
(setq d (cadr (nth i para_list)))
(setq ds (append ds (list d)))
(if (>= d (apply 'max ds))
(progn
(newlayer "1" 1 nil)
(command "_.circle" ptLeftCenter "d" d)
)
(progn
(newlayer "dash" 4 "dashed")
(command "_.circle" ptLeftCenter "d" d)
)
)
(setq i (1- i))
)
(setq m (* (apply 'max ds) 1.1))
(setq pt1 (polar ptLeftCenter (/ pi 2) (+ (/ m 2) 0)))
(setq pt2 (polar ptLeftCenter (* (/ pi 2) 3) (+ (/ m 2) 0)))
(setq pt3 (polar ptLeftCenter pi (+ (/ m 2) 0)))
(setq pt4 (polar ptLeftCenter 0 (+ (/ m 2) 0)))

(newlayer "center" 3 "center")
(command "_.line" pt1 pt2 "")
(command "_.line" pt3 pt4 "")
ds
) (defun DrawLine(ds para_list ptLeftCenter / n i md ptsc ptse l ls d pt1 pt2 pt3 pt4 pta1 pta2 ptdim1 ptdim2 ptdimc ptd)
(setq n (length ds))
(setq i 1)
(setq ds (reverse ds))
(setq md (apply 'max ds))
(setq ptsc (polar ptLeftCenter 0 (* md 1.2)))
(setq ls (append ls (list (car (nth i para_list)))))
(newlayer "1" 1 nil)
;;;画轴及标注所需各点——第一阶轴 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq pt1 (list (+ (car ptsc) (car (nth 0 para_list))) (+ (cadr ptsc) (/ (nth 0 ds) 2.0)))); ptdim1 ;
(setq pt2 (list (car ptsc) (+ (cadr ptsc) (/ (nth 0 ds) 2.0)))); pt2┌─────┐pt1;
(setq pt3 (list (car ptsc) (- (cadr ptsc) (/ (nth 0 ds) 2.0)))); │ │ ;
(setq pt4 (list (+ (car ptsc) (car (nth 0 para_list))) (- (cadr ptsc) (/ (nth 0 ds) 2.0)))); │ ptdimc │ ;
(setq pta1 pt1 pta2 pt4); │ │ ;
(setq ptdimc (list (- (car pt2) 3.0) (cadr ptsc))); pt3└─────┘pt4;
(setq ptsc (polar pt1 (/ (* pi 3.0) 2.0) (/ (nth 0 ds) 2.0))); ptdim2 ;
(setq ptd (polar ptsc (/ (* pi 3.0) 2.0) (+ (/ md 2.0) 5))); ;

(command "_.pline" pt1 pt2 pt3 pt4 "c")
(newlayer "dim" 3 nil)
(command "_.dimlinear" pt2 pt3 ptdimc)
(command "_.dimlinear" pt3 pt4 ptd)
(while (< i n)
(setq l (car (nth i para_list)))
(setq ls (append ls (list l)))
(setq d (nth i ds))
;;;画轴及标注所需各点;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;
(setq pt1 (list (+ (car ptsc) l) (+ (cadr ptsc) (/ d 2.0)))); ptdim1 pt1 ;
(setq pt2 (list (car ptsc) (+ (cadr ptsc) (/ d 2.0)))); pt2┌─────┐ ;
(setq pt3 (list (car ptsc) (- (cadr ptsc) (/ d 2.0)))); pta1│ │ ;
(setq pt4 (list (+ (car ptsc) l) (- (cadr ptsc) (/ d 2.0)))); ptdimc │ ;
(setq ptdim1 (list (/ (+ (car pt1) (car pt2)) 2.0) (cadr pt1))); pta2│ │ ;
(setq ptdim2 (polar ptdim1 (/ (* pi 3.0) 2.0) d)); pt3└─────┘pt4;
(setq ptdimc (polar ptdim1 (/ (* pi 3.0) 2.0) (/ d 2.0))); ptdim2 ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;

(newlayer "1" 1 nil);
(if (> (cadr pt2) (cadr pta1))
(command "_.pline" pta1 pt2 pt1 pt4 pt3 pta2 "")
(command "_.pline"pt2 pt1 pt4 pt3 "")
)

(if (= i (1- n))
(progn
(setq ptdimc (list (+ 5 (car pt1)) (cadr ptdimc)))
(setq ptdim1 pt1)
(setq ptdim2 pt4)
)
)
(newlayer "dim" 3 nil)
(command "_.dimlinear" ptdim1 ptdim2 ptdimc)
(command "_.dimlinear" pt3 pt4 ptd)
(setq pta1 pt1 pta2 pt4)
(setq ptsc (polar pt1 (/ (* pi 3) 2) (/ d 2)))
(setq i (1+ i))
)
(setq ptsc (polar ptLeftCenter 0 (- (* md 1.2) 3)))
(setq ptse (polar ptsc 0 (+ (apply '+ ls) 6)))
(newlayer "center" 3 "center")
(command "_.line" ptsc ptse "")
) (defun c:shaft2( / n width height para_list olduprec oldse1 oldse2 oldcen os cmd ds ptLeftCenter)
(setq cmd (getvar "cmdecho"))
(setq os (getvar "osmode"))
;(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "LUPREC" 2)

(setq n (getint "输入轴阶数:"))
(initget 7)
(setq i 0)
(repeat n
(setq i (1+ i))
(setq width (getreal (strcat "第" (itoa i) "阶轴长度:")))
(initget 7)
(setq height (getreal (strcat "第" (itoa i) "阶轴直径:")))
(initget 7)
(setq para_list (append para_list (list (list width height))))
)
(setq ptLeftCenter (getpoint "左视图中心点:")) (loadline "center")
(loadline "dashed")

(setq ds (drawcircle para_list ptLeftCenter));画圆
(setvar "LTSCALE" (/ (apply 'max ds) 100))
(setvar "dimtxt" 2.5)
(drawline ds para_list ptLeftCenter);画各轴
(command "regen")
(setvar "cmdecho" cmd)
(setvar "osmode" os)
;para_list
(princ)
) (defun c:test( / i n)
(setq i 0)
(setq n 100)
(while (< i n)
(cond
((< i 10) (princ "aaa"))
((< i 20) (princ "bbb"))
((< i 100) (princ i))
)
(princ "\n")
(setq i (1+ i))
)
)

yaohui

谢谢飞哥了，我看看能不能看明白，到时在向飞哥请教

yaohui

飞哥，调入时怎么光有数据啊，只是在求值啊，没图啊，是不是还要编译呢，怎作那，请指教，我得弄个图出来啊

meflying

不知道你要个程序干什么？给你个程序，又一点都看不懂。。。


建议你找本入门的书（随便哪本都可以的），先慢慢看，

yaohui

实话说吧，我是应付老师的啊，要用lisp编个程序作图出来就行了，你得帮帮我啊

cxzr8

干嘛非要别人帮着害你呢，兄弟

yaohui

不是那样的呵，我是用cad作图的，选修的课程啊，现在能画图了，编程真是天书呵，不好意思，这方面只好求教大侠了！

meflying

你连加载使用程序都不会，怎么说能写程序给老师？别人给你的程序你又怎么知道行不行呢？


我给的第二个程序是可以的。。。