明经QQ群汇总

日升月恒

收到

liushaobo

烦请各位高手帮小弟完成此序程孔径列表

liushaobo

(defun C:DM()
 (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)
)

轩辕凝决

时髦的玩意

baohui668

QQ:13757306

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

psufngah

22584977

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

kbssavor

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

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

是怎么一回事呀？

mccad

网站程序这段时间升级，一些频道并未完成。

smok

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

1dpf520

[这么多群啊!!!

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

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