无奈哭求：高手给偶贴一个轴的参数化小程序啊

bitterwood · 发表于 2005-4-24 19:22:00

我怎么就编不出来呢？

还有后续的啊。不过都比较简单。

高手加我qq啊51552441

马上要交了，老师已经骂过我了。谁可怜可怜我啊。

meflying · 发表于 2005-4-25 08:46:00

要复杂的吗?看你敢不敢交...

(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) 9)))
(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))
)
)

(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) 9)))
   (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))
   )
)

bitterwood · 发表于 2005-4-25 09:39:00

晕咯，偶只想要一个普通的轴的小程序啊。会的人估计1分钟可以搞定。

你这个太牛。我只能学学。对以后画大图有帮助啊。

在问个问题就是我画个圆然后用thickness也不知道干什么的。

然后用command什么命令可以让他成3维的呢？

谢谢咯，可以加你qq请教吗？

迷茫中啊

yinruch01 · 发表于 2005-4-25 10:22:00

thickness设置厚度以变成三维圆桶,用EXTRUDE命令可以把圆变成三维实体

jordan · 发表于 2005-4-30 23:12:00

用我的程序吧。很简单。而且可以生成无限段轴。希望对你有用..不过我是在清华天河里编写的。所以如果你没装清华天河，请把所有的图层改成与程序中相对应的层。否则程序会报错。。。不便之处还望谅解。我现在工作忙。很少写程序了。。以后有机会写啊。呵呵。。。清华天河是个好软件。一定要装上试试啊。：)

愿意的话。可以加我QQ。一起探讨。我也好多地方不懂。感谢明经。感谢大家。。没有明经，就没有我们今天的一切。。QQ：27362275，加我时请发信息。明经有我更精采。。

jordan · 发表于 2005-4-30 23:21:00

我不知道这样的程序对你是否有用。诸如还有倒角。键槽之类的结构绘制。。我就没做了。。如果你有兴趣。自已架上啊。呵呵。。。不过这个程序让你完成差事。应该还可以吧。如果不行。。发过来问题，反正五一在家没事。。邦你把它做完。。常在明经里。可以学到很多东西的。。

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

无奈哭求：高手给偶贴一个轴的参数化小程序啊

本帖子中包含更多资源