- UID
- 57918
- 积分
- 0
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2003-6-13
- 最后登录
- 1970-1-1
|
发表于 2007-9-25 09:15:50
|
显示全部楼层
"在明经网站上没有人能解决的难题"这种说法太不地道
这个程序其实编起来不难,难的是对功能需求的描述,象前面那样,简单说几句话,没人知道怎么编。
我以前帮别人弄了一个,由于不是做这个的,功能方面不一定合理,供参考。
;这并不能算完整的程序,只是提供个思路
;
(vl-load-com)
(defun c:bo (/ block block_lis col col_lis sel i i1 i2 cir cir_lis pat_cir_lis tem temlis p
name name_lis jiaz_date
b_ins t_ins)
(defun b_ins (p1 b_name col / ent)
(if (null (tblsearch "BLOCK" b_name))
(progn (command "insert" b_name p1)
(while (> (getvar "cmdactive") 0) (command ""))
(entdel (entlast))
)
)
(setq ent '((43 . 1.0) (42 . 1.0) (41 . 1.0) (0 . "INSERT"))
ent (cons (cons 2 b_name) ent)
ent (cons (cons 62 col) ent)
ent (cons (cons 10 p1) ent)
ent (reverse ent)
)
(entmake ent)
)
(defun t_ins (p1 s h / ent)
(setq ent '((67 . 0)(0 . "TEXT"))
ent (cons (cons 40 h) ent)
ent (cons (cons 1 s) ent)
ent (cons (cons 10 p1) ent)
ent (reverse ent)
)
(entmake ent)
)
(setq col_lis '(1 3 4 5 6 7));颜色列表
(setq block_lis'("1" "25" "2" "40" "35" "31" "44" "10" "5" "24" "38" "20" "42" "39" "32" "26" "41" "28" "18" "34" "9" "37" "36" "29" "15" "50" "22" "27" "46" "19" "17" "16" "48" "23" "43" "49" "11" "100"));图块名称列表
(setq tol 0.001);允许绘图偏差
(setq sel (ssget '((0 . "CIRCLE"))))
(setq cir_lis '() name_lis '())
(if (not (null sel))
(while (setq name (ssname sel 0))
(setq tem (entget name)
temlis (list (assoc 10 tem) (* 2.0 (cdr (assoc 40 tem))))
)
(if (not (member temlis cir_lis))
(setq cir_lis (cons temlis cir_lis)
name_lis (cons name name_lis)
)
)
(ssdel name sel)
)
)
(setq cir_lis (mapcar '(lambda (e1 e2) (append e1 (list e2))) cir_lis name_lis))
;cir_lis格式:中心点 直径 图元名称
(setq p (getpoint "\n请输入表格插入位置:"))
(setq p (trans p 1 0))
(setq i 1 ;序列号
i1 0 ;颜色序列号
i2 0 ;图块序列号
)
(t_ins (mapcar '+ p '(13.75 -10.0 0.0)) "总 和" 3.85)
(t_ins (mapcar '+ p '(35.5 -3.0 0.0)) "======" 2.75)
(t_ins (mapcar '+ p '(40 -5.5 0.0)) (rtos (length cir_lis) 2 0) 2.2)
(setq jiaz_date (getreal "\n请输入加针<手动输入加针结果>:"))
(while (> (length cir_lis) 0)
(setq d (cadr (car cir_lis)))
(foreach cir cir_lis
(if (< (cadr cir) d)
(setq d (cadr cir))
)
)
;(alert (vl-princ-to-string d))
(setq pat_cir_lis '()
tem '()
)
(foreach cir cir_lis
(if (equal d (cadr cir) tol)
(setq pat_cir_lis (cons cir pat_cir_lis))
(setq tem (cons cir tem))
)
)
(setq cir_lis tem)
(if (> (length pat_cir_lis) 0)
(progn
;突出显示此类圆
(foreach cir pat_cir_lis
(redraw (caddr cir) 3)
)
(redraw)
;输入针径;PGH")或(setq s"邮票孔")或(setq s"断线孔"这三样啊
(if (null jiaz_date)
(progn
(setq s (getstring (strcat "\n孔径=" (rtos d 2 3) "输入<孔径(P:PGH, Y:邮票孔, D:断线孔, 其它) ,>针径:")))
(setq ds (rtos d 2 3))
(cond
((= s "")(setq s "****"))
((or (= (substr s 1 2) "P,") (= (substr s 1 2) "p,")) (setq ds "-PGH-" s (substr s 3)))
((or (= (substr s 1 3) "P ,") (= (substr s 1 3) "p ,")) (setq ds "-PGH-" s (substr s 4)))
((or (= (substr s 1 3) "P,") (= (substr s 1 3) "p,")) (setq ds "-PGH-" s (substr s 4)))
((or (= (substr s 1 4) "P ,") (= (substr s 1 4) "p ,")) (setq ds "-PGH-" s (substr s 5)))
((or (= (substr s 1 1) "P") (= (substr s 1 1) "p")) (setq ds "-PGH-" s (substr s 2)))
((or (= (substr s 1 2) "Y,") (= (substr s 1 2) "y,")) (setq ds "邮票孔" s (substr s 3)))
((or (= (substr s 1 3) "Y ,") (= (substr s 1 3) "y ,")) (setq ds "邮票孔" s (substr s 4)))
((or (= (substr s 1 3) "Y,") (= (substr s 1 3) "y,")) (setq ds "邮票孔" s (substr s 4)))
((or (= (substr s 1 4) "Y ,") (= (substr s 1 4) "y ,")) (setq ds "邮票孔" s (substr s 5)))
((or (= (substr s 1 1) "Y") (= (substr s 1 1) "y")) (setq ds "邮票孔" s (substr s 2)))
((or (= (substr s 1 2) "D,") (= (substr s 1 2) "d,")) (setq ds "断线孔" s (substr s 3)))
((or (= (substr s 1 3) "D ,") (= (substr s 1 3) "d ,")) (setq ds "断线孔" s (substr s 4)))
((or (= (substr s 1 3) "D,") (= (substr s 1 3) "d,")) (setq ds "断线孔" s (substr s 4)))
((or (= (substr s 1 4) "D ,") (= (substr s 1 4) "d ,")) (setq ds "断线孔" s (substr s 5)))
((or (= (substr s 1 1) "D") (= (substr s 1 1) "d")) (setq ds "断线孔" s (substr s 2)))
((setq tem (vl-string-search "," s))(setq ds (substr s 1 tem) s (substr s (+ 2 tem))))
((setq tem (vl-string-search "," s))(setq ds (substr s 1 tem) s (substr s (+ 3 tem))))
(T (princ))
)
(setq tem (rtos (atof s) 2 2))
(if (> (strlen tem)(strlen s)) (setq s tem))
)
(progn
(cond
((equal d 0.99 0.001) (setq ds "-PGH-" s 1.00))
((equal d 1.09 0.001) (setq ds "-PGH-" s 1.10))
((equal d 1.29 0.001) (setq ds "-PGH-" s 1.30))
((equal d 1.49 0.001) (setq ds "-PGH-" s 1.50))
((equal d 1.01 0.001) (setq ds "邮票孔" s 1.00))
((equal d 1.31 0.001) (setq ds "邮票孔" s 1.30))
((equal d 1.51 0.001) (setq ds "邮票孔" s 1.50))
((equal d 1.02 0.001) (setq ds "断线孔" s 1.00))
((equal d 1.32 0.001) (setq ds "断线孔" s 1.30))
((equal d 1.52 0.001) (setq ds "断线孔" s 1.50))
(T (setq ds (rtos d 2 3) s (+ d jiaz_date)))
)
(setq s (rtos s 2 2))
)
)
;(if (null s) (setq s "****")(setq s (rtos s 2 2)))
;关闭此类圆突出显示
(foreach cir pat_cir_lis
(redraw (caddr cir) 4)
)
(redraw)
;写序列号 i
(t_ins p (rtos i 2 0) 2.75)
;确定颜色
(if (setq col (nth i1 col_lis))
(setq i1 (1+ i1))
(setq i1 1
col (car col_lis)
)
)
;确定图块名称
(if (setq block (nth i2 block_lis))
(setq i2 (1+ i2))
(setq i2 1
block (car block_lis)
)
)
;表格内插入图块
(b_ins (mapcar '+ p '(10.45 0.99 0.0)) block col)
;写孔径
(t_ins (mapcar '+ p '(17.75 0.0 0.0)) ds 2.75)
;写针径
(t_ins (mapcar '+ p '(31.6 0.0 0.0)) s 2.75)
;写数量
(t_ins (mapcar '+ p '(43.0 0.0 0.0)) (rtos (length pat_cir_lis) 2 0) 2.75)
;图上做标记
(foreach cir pat_cir_lis
(b_ins (cdar cir) block col)
)
(setq i (1+ i)
p (polar p (/ pi 2.0) 5.5)
)
)
)
)
(t_ins (mapcar '+ p '(-2.27 0.0 0.0)) "序号" 2.75)
(t_ins (mapcar '+ p '(6.68 0.0 0.0)) "符号" 2.75)
(t_ins (mapcar '+ p '(17.69 0.0 0.0)) "孔径" 2.75)
(t_ins (mapcar '+ p '(30.83 0.0 0.0)) "针径" 2.75)
(t_ins (mapcar '+ p '(41.47 0.0 0.0)) "数量" 2.75)
(if (> i2 (+ (length block_lis) 1)) (alert " 直径类型超过了符号数量,部分符号重复使用了!"))
(princ)
) |
|