明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

楼主: mccad

明经QQ群汇总

  [复制链接]
发表于 2005-11-27 12:33 | 显示全部楼层
收到
发表于 2006-2-12 21:33 | 显示全部楼层
烦请各位高手帮小弟完成此序程孔径列表
发表于 2006-2-12 21:42 | 显示全部楼层
(defun CM()
 (setq ooo (list 0.0 0.0 0.0))
 (setvar "cmdecho" 0)
 (command "layer" "s"  "dim" "")
 (setq pnd (ssget "X" (list(cons 8 "dim"))))
 (command "erase" pnd "")
 (setq pnd (ssget "X" (list(cons 8 "center")(cons 40 2.00))))
 (command "erase" pnd "")
 (command "redraw")
 (princ "\n尺寸标注" )
 (princ "\n第一端点<<左>>:" )
 (setvar "OSMODE" 1)
 (setq p0 (getpoint))
 (princ "\n第二端点<<右>>:" )
 (setq p1 (getpoint))
 (setvar "OSMODE" 0)
;(command "dim" "horizontal" p0 p1 pause "" "exit")
 (princ "\n尺寸标注" )
 (princ "\n第一端点<<上>>:" )
 (setvar "OSMODE" 1)
 (setq p2 (getpoint))
 (princ "\n第二端点<<下>>:" )
 (setq p3 (getpoint))
 (setvar "OSMODE" 0)
;(command "dim" "vertical" p2 p3 pause "" "exit")
 (setq x0 (car p0)) (setq y0 (cadr p0))
 (setq x1 (car p1)) (setq y1 (cadr p1))
 (setq x2 (car p2)) (setq y2 (cadr p2))
 (setq x3 (car p3)) (setq y3 (cadr p3))
 (if (> x0 x1)(setq x x0))
 (if (< x0 x1)(setq x x1))
 (if (> y2 y3)(setq y y2))
 (if (< y2 y3)(setq y y3))
 (setq dxx (/ (+ x0 x1) 2))
 (setq dyy (/ (+ y2 y3) 2))
 (setq dx (abs (- x0 x1)))(setq dy (abs (- y2 y3)))
 (setq x (+ x 15))
 (setq y (+ y 5))
 (setq pcx (list dxx dyy 0.0))
 (setq px (list x0 y 0.0))
 (setq py (list x  y1 0.0))
 (command "dim" "horizontal" p0 p1 px "" "exit")
 (command "dim" "vertical" p2 p3 py "" "exit")
 (command "move" "all" "0,0" "" pcx "0,0" "" aa)
 (setq pn (ssget "X" (list(cons 0 "CIRCLE")(cons 8 "pin")(CONS 40 2) )))
 (setq k0 (ssname pn 0))
 (setq o1 (cdr (assoc 10 (entget k0))))
 (setq k1 (ssname pn 1))
 (setq o2 (cdr (assoc 10 (entget k1))))
 (setq o1x (car o1)) (setq o1y (cadr o1))
 (setq o2x (car o2)) (setq o2y (cadr o2))
 (setq po1 (list o1x (- fyo (/ dy 2))))
 (command "dim" "ordinate" o1 po1 "")
 (setq po2 (list o2x (- fyo (/ dy 2))))
 (command "dim" "ordinate" o2 po2 "")
 (if (> o1x o2x)(progn
                 (setq po3 (list (+ (- -5 (/ dx 2)) fxo) o2y)) (setq po o2)(setq poa o1)
                 (command "dim" "ordinate" o2 po3 "")))
 (if (> o2x o1x)(progn
                 (setq po3 (list (+ (- -5 (/ dx 2)) fxo) o1y)) (setq po o1)(setq poa o2)
                 (command "dim" "ordinate" o1 po3 "")))
(setq xx (list fxo (+ (- -15 (/ dy 2)) fyo) 0.0))
 (setq yy (list (+ (- -15 (/ dx 2)) fxo)  fyo))
                 (command "dim" "ordinate" oo xx "")
                 (command "dim" "ordinate" oo yy "")
 (if(/= oo ooo)(progn
(setq xx (list 0.0 (+ (- -15 (/ dy 2)) fyo) 0.0))
 (setq yy (list (+ (- -15 (/ dx 2)) fxo)  0.0 0.0))
                 (command "dim" "ordinate" ooo xx "")
                 (command "dim" "ordinate" ooo yy "")
                 ))
 (command "exit")
 (initget 128 "0 1 2 " )
 (setq bh (getkword "\n请选择 <0>一次冲 <1>第一次冲 <2>第二次冲"))
 (if (= bh nil) (setq bh ""))
 (if (= bh "0") (setq bh ""))
 (setq f "c:\\dwg\\")
 (setq fn (getvar "dwgname"));(setq df (strlen (getvar "dwgprefix")))
 ;(setq df (+ df 1))
  (setq nam (substr fn 1 4))
 (setq f (strcat f nam))(setq f (strcat f bh))
 (setq f (strcat f "pin"))
 (setq ap (open f "w"))(princ dx ap)(princ " " ap)(princ dy ap)(princ "\n" ap)
 (princ (car po) ap)(princ " " ap)(princ (cadr po) ap)(princ "\n" ap)(close ap)
 (setq f1 "c:\\dwg\\")(setq f1 (strcat f1 nam))(setq f1 (strcat f1 bh))  (setq f1 (strcat f1 "pin"))
 (setq bp (open f1 "w"))(princ dx bp)(princ " " bp)(princ dy bp)(princ "\n" bp)
 (princ (car po) bp)(princ " " bp)(princ (cadr po) bp)(princ "\n" bp)
 (princ (car poa) bp)(princ " " bp)(princ (cadr poa) bp)(princ "\n" bp)
;(setq py1 (fix (/ dy 2)))
 (setq py1 dyy)
 (setq cx (/ dx 2))
 (setq fx (* 10 (fix (/ (+ dx 19.99999) 10))))
;(setq px1 (+ (* 10 (fix (/ (+ dx 6) 10))) 5))
;(setq dv (- px1 dx))(if (< dv  5)(setq px1  (+ px1  10)))
;(princ (/ (+ x0 x1) 2) bp)(princ "\n" bp)(princ (/ (+ y2 y3) 2) bp)
;(princ "-5.0" bp)(princ py1 bp)(princ "\n" bp)(princ px1 bp)(princ " " bp)(princ py1 bp)
 (close bp)
 (setq do1 (list (- (/ (+ x0 x1) 2) (/ fx 2)) py1 0.0))
;(setq do2 (list px1 py1 0.0))
 (setq do2 (list (+ (/ (+ x0 x1) 2) (/ fx 2)) py1 0.0))
 (command "layer" "s"  "center" "")
 (command "circle" do1 "2" )
 (command "circle" do2 "2" )
 (setq pns (ssget "X" (list(cons 0 "CIRCLE")(cons 8 "center")(CONS 40 2) )))
 (command "move" pns "" pcx oo)
 (if (/= o1y o2y)(progn
                 (setq pnd (ssget "X" (list(cons 8 "dim"))))
                 (command "erase" pnd "")(command "redraw")
                 (setq pnd (ssget "X" (list(cons 8 "center"))))
                 (command "erase" pnd "")(command "redraw")
                 (command "layer" "s"  "pin" "")
                 (princ "\n固定柱未在同一线上,请重新设置")
                 ))
 (setvar "cmdecho" 1)
)
发表于 2006-2-13 10:35 | 显示全部楼层
时髦的玩意
发表于 2006-4-7 15:02 | 显示全部楼层

QQ:13757306

ARX开发群,另有少数VBA,人数不多了:)

发表于 2006-5-18 22:48 | 显示全部楼层

22584977

CAD交流二次开发的都可以来加!

发表于 2006-12-23 11:47 | 显示全部楼层

想去聊天室,却遇闭门羹。

对不起,程序所在目录不是虚拟目录,或设置有错误,Global.asa 没有被执行。本程序需要虚拟目录的支持!

是怎么一回事呀?

 楼主| 发表于 2006-12-23 13:03 | 显示全部楼层
网站程序这段时间升级,一些频道并未完成。
发表于 2007-1-17 09:38 | 显示全部楼层

既然都满了!那就不加了!

发表于 2007-2-23 16:48 | 显示全部楼层

[这么多群啊!!!

这里也有个聊天室,大家有空也可进这里面聊聊啊!!~~~~~~~~~~

有兴趣交流的可以Q我:279710796说明是"明经"就可以了~V~

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2018-9-25 07:01 , Processed in 0.202235 second(s), 22 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表