- UID
- 378930
- 积分
- 12
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2006-1-7
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
:[编程申请]:学术不分网界,谁能帮完成此程式,工作需要,甚是感谢!! 9pt 10pt 11pt 12pt 13pt 15pt
:[编程申请]:学术不分网界,谁能帮完成此程式,工作需要,甚是感谢!! http://www.mjtd.com/BBS/dispbbs.asp...ID=62458&page=1
dwg文件已传了请各位老师帮帮忙是否能解决此问题,本人的意思是执行命令自动选择0层与G层的孔后,
在命令行直接输入要加大的每种圆孔的针径完毕后就自动产生出,(序号、符号、孔径、针径、数量、总和).
参考例:::::::::::::::::以前找到的范例::::::::::::::::::
(defun C:tjb
(/ HOLDOSMODE HOLDZIN HOLDECHO HOLE_LIST #FF R1_LIST)
(defun WRITE_LINE (/ LL)
(setq #FF (polar #FF (/ pi 2.0) (* #H 1.5)))
(command "_.line"
(polar #FF pi (* #H 4.5))
(polar #FF 0 (* #H 19))
""
)
(command "_.ARRAY"
(entlast)
""
"R"
(+ (length R1_LIST) 2)
""
(* -2 #H)
)
(command "_.line"
(polar #FF pi (* #H 4.5))
(cdr (assoc 10 (entget (entlast))))
""
)
(setq LL (entlast))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 4.3)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 9.5)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 13.5)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 18.5)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 23.5)))
)
(defun WRITE_TABLE (H_LIST / DATA #F zj)
(if (= #H NIL)
(setq #H 5)
)
(setq zj 0)
(while (= #F NIL)
(initget 1 "P ")
(setq #F (getpoint "\\n表格左上角/字体高度<P>: "))
(if (= #F "P")
(progn
(setq
#H (getreal (strcat "\\n字体高度<" (rtos #H 2 0) ">: "))
)
(setq #F NIL)
)
)
)
(setq #FF #F)
(command "_.text" "j" "C" #F #H "" "符号 序号")
(command "_.text"
"j"
"C"
(polar #F 0 (* #H 7))
#H
""
"孔径"
)
(command "_.text"
"j"
"C"
(polar #F 0 (* #H 12))
#H
""
"冲针"
)
(command "_.text"
"j"
"C"
(polar #F 0 (* #H 17))
#H
""
"数量"
)
(setq #F (polar #F (/ pi -2.0) (* #H 2)))
(setq N 1)
(while (/= (setq DATA (car H_LIST)) NIL)
(command "_.text"
"j"
"c"
(polar #F 0 (* #H 7))
#H
""
(strcat "Φ" (rtos (* (car DATA) 2.0) 2 2))
)
(command "_.text"
"j"
"C"
(polar #F 0 (* #H 12))
#H
""
(strcat "Φ" (rtos (* (car DATA) 2.0) 2 2))
)
(command "_.text"
"j"
"C"
(polar #F 0 (* #H 17))
#H
""
(rtos (cadr DATA))
)
(command "_.text"
"j"
"C"
(polar #F 0 (* #H 2.5))
#H
""
(rtos N)
)
(command "_.circle"
(polar #F 0 (* #H -3))
(car DATA)
)
(setq #F (polar #F (/ pi -2.0) (* #H 2)))
(setq zj (+ zj (cadr DATA)))
(setq H_LIST (cdr H_LIST))
(setq N (1+ N))
)
(setq #F (polar #F (/ pi -40.0) (* #H 2)))
(command "_.text"
"j"
"C"
(polar #F 0 (* #H 13.5))
#H
""
(strcat "总数=" (rtos zj))
)
)
(defun MAKE_LIST (/ SS N R_LIST TMP)
(if (setq SS (ssget "X" '((0 . "CIRCLE"))))
(progn
(setq N 0)
(repeat (sslength SS)
(if (not (member
(setq TMP (cdr (assoc 40 (entget (ssname SS N)))))
R_LIST
)
)
(setq R_LIST (append R_LIST (list TMP)))
)
(setq N (1+ N))
)
)
)
(setq N 0)
(repeat (length R_LIST)
(setq
TMP (ssget "X"
(list (cons 0 "CIRCLE") (cons 40 (nth N R_LIST)))
)
)
(setq
R1_LIST (append R1_LIST
(list (list (nth N R_LIST) (sslength TMP)))
)
)
(setq N (1+ N))
)
)
(setq HOLDECHO (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "_.UNDO" "_GROUP")
(setq HOLDOSMODE (getvar "OSMODE"))
(setq HOLDZIN (getvar "DIMZIN"))
(setvar "DIMZIN" 8)
(setvar "OSMODE" 0)
(MAKE_LIST)
(WRITE_TABLE
(vl-sort R1_LIST
(function (lambda (E1 E2)
(< (car E1) (car E2))
)
)
)
)
(WRITE_LINE)
(setvar "OSMODE" HOLDOSMODE)
(setvar "DIMZIN" HOLDZIN)
(command "_.UNDO" "_END")
(setvar "CMDECHO" HOLDECHO)
(princ)
)
;;;;;;;;;;
;制作孔径符用
;请参考这个,你说的同心圆也过滤,但究竟是取大圆还是取小圆呢?没说清楚我也没做。
;这;个只是对直径相同的圆进行编号,没有考虑同心圆的情况,请自己再完善吧...
(Defun c:test6 (/ ss i lstCir en code txt lst)
(VL-LOAD-COM)
;; Get the selection set .
(princ "\nPlease select circle objects:")
(setq ss (vl-catch-all-apply 'ssget (list '((0 . "circle")))))
(if (or (vl-catch-all-error-p ss) (null ss))
(vl-exit-with-value 0)
)
;; init the i=0, lstCir= nil .
(setq i 0
lstCir '()
)
;; repeat to get the circle data to the list lstCir .
(repeat (sslength ss)
(setq en (ssname ss i)
i (1+ i)
)
(if (assoc (cdr (assoc 40 (entget en))) lstCir)
(setq lstCir (subst (append (assoc (cdr (assoc 40 (entget en))) lstCir) (list en))
(assoc (cdr (assoc 40 (entget en))) lstCir)
lstCir
)
)
(setq lstCir (cons (list (cdr (assoc 40 (entget en))) en) lstCir))
)
)
;; start to the "A" .
(setq code 64)
(foreach Cirs lstCir
(setq txt (chr (setq code (1+ code))))
(foreach cir (cdr Cirs)
(setq lst (list '(0 . "text") (cons 1 txt) (assoc 10 (entget cir)) '(40 . 2)))
(entmake lst)
)
)
) |
|