求助飞哥

yaohui · 发表于 2004-2-28 15:22:00

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

meflying · 发表于 2004-2-28 17:02:00

你想做什么呢？
简单的：
(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 ( (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))
   )
)