原创，圆孔生成镙丝孔
本帖最后由 邹锋 于 2013-4-14 04:10 编辑好久没来，最近闲着无事，练练手，整个LISP ，比较适合做机械朋友使用
由于我们UG转出来的图档里没有标明哪些孔是镙丝孔，哪些是顶针孔，所以需要朋友们去一个个注明， 一套模具有几十个几百个，也挺累的，于是，我就有这个想法了，
(defun c:sww()
;----系统变量备份----
(setvar "cmdecho" 0);_关闭命令提示
(command "undo" "be")
(setq osmode_bak (getvar "osmode"));_记录捕捉
(setvar "osmode" 0);_关闭捕捉
(setq clayer_bak (getvar "clayer"));_记录当前图层
(setq cecolor_bak (getvar "cecolor"));_记录当前颜色
(setq celtype_bak (getvar "celtype"));_记录当前线型
(setq textstyle_bak (getvar "textstyle"));_记录当前文字样式
(setq chksty (tblsearch "style" "TXT"))
(if (= chksty nil)
(entmake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") (cons 2 "TXT")
'(70 . 0) (cons 40 1) (cons 41 1) '(3 . "txt.shx") '(4 . "gbcbig.shx")
)
)
)
(setq chklty (tblsearch "LTYPE" "CENTER"))
(if (= chklty nil)
(entmake (list '(0 . "LTYPE") '(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLinetypeTableRecord")
(cons 2 "CENTER")'(3 . "Center ____ _ ____ _ ____ _ ____ _ ____ _ ____")
'(70 . 0)'(73 . 2) '(40 . 15.0) '(49 . 10.0)'(74 . 0) '(49 . -5.0) '(74 . 0)
)
)
)
(setq ss (ssget '((0 . "CIRCLE")))
i0)
(repeat (sslength ss)
(setq ename (ssname ss i)
dat (entget ename)
pt (usdxf 10 dat)
r (dxf 40 dat)
cel (dxf 6 dat)
D (* R 2)
)
(if (or (= cel "DASHED") (= cel "HIDDEN"))
(setq cel "HIDDEN")
(setq cel "Continuous")
)
(cond ((= d2.5)
(setq text "M3")
(setq xk 0.06)
(setq mr 1.5)
(makent)
)
((= d 3.3)
(setq text "M4")
(setq xk 0.08)
(setq mr 2)
(makent)
)
((= d 4.2)
(setq text "M5")
(setq xk 0.1)
(setq mr 2.5)
(makent)
)
((= d 5)
(setq text "M6")
(setq xk 0.12)
(setq mr 3)
(makent)
)
((= d 6.8)
(setq text "M8")
(setq xk 0.16)
(setq mr 4)
(makent)
)
((= d 8.5)
(setq text "M10")
(setq xk 0.2)
(setq mr 5)
(makent)
)
((= d 10.5)
(setq text "M12")
(setq xk 0.24)
(setq mr 6)
(makent)
)
((= d 12)
(setq text "M14")
(setq xk 0.28)
(setq mr 7)
(makent)
)
((= d 14)
(setq text "M16")
(setq xk 0.32)
(setq mr 8)
(makent)
)
((= d 15.5)
(setq text "M18")
(setq xk 0.36)
(setq mr 9)
(makent)
)
((= d 17.5)
(setq text "M20")
(setq xk 0.4)
(setq mr 10)
(makent)
)
)
(setq i (1+ i))
)
;----系统变量还原----
(setvar "osmode" osmode_bak);_还原捕捉
(setvar "clayer" clayer_bak);_还原图层
(setvar "cecolor" cecolor_bak);_还原颜色
(setvar "celtype" celtype_bak);_还原线型
(setvar "textstyle" textstyle_bak);_还原文字样式
(command "undo" "e")
(setvar "cmdecho" 1);_打开命令提示
(princ);_关闭程序返回值
)
(defun makent ()
;;;计算点
(setq dist (* mr 1.1))
(setq texth (* mr 0.4))
(setq pt1 (polar pt 0 dist))
(setq pt2 (polar pt (* PI 0.5) dist))
(setq pt3 (polar pt pi dist))
(setq pt4 (polar pt (* 1.5 pi) dist))
(setq tept1 (polar pt pi (* mr 2 0.17)))
(setq textpt (polar tept1 (* 1.5 pi) (* mr 2 0.25)))
;生成圆
(entmake (list (cons 0 "CIRCLE")
(cons 67 0)
(CONS 62 33)
(cons 8 "screw")
(cons 6cel)
(cons 48 xk)
(cons 10 pt)
(cons 40 r)
)
)
(setq en1 (entlast))
;生成中心线
(entmake (list (cons 0 "LINE")
(cons 8 "screw")
(CONS 62 1)
(cons 6"CENTER")
(cons 48 xk)
(cons 10 pt1)
(cons 11 pt3)
)
)
(setq en2 (entlast))
;生成中心线
(entmake (list (cons 0 "LINE")
(cons 8 "screw")
(CONS 62 1)
(cons 6"CENTER")
(cons 48 xk)
(cons 10 pt2)
(cons 11 pt4)
)
)
(setq en3 (entlast))
;生成圆弧
(entmake (list (cons 0 "ARC")
(cons 8 "screw")
(CONS 62 92)
(cons 6 cel)
(cons 48 xk)
(cons 10 pt)
(cons 40 mr)
(list 210 0.0 0.0 1.0)
(cons 50 4.71239)
(cons 51 3.14159)
)
)
(setq en4 (entlast))
;;;生成文字
(entmake (list (cons 0 "TEXT")
(cons 8 "screw")
(CONS 62 6)
(cons 10 textpt)
(cons 40 texth)
(cons 1 text)
(cons 7 "TXT")
(cons 41 1)
(cons 51 0.0)
(cons 71 0)
(cons 72 0)
(cons 73 0)
(list 210 0.0 0.0 1.0)
)
)
(setq en5 (entlast))
;;;做成块
(setq sslist (ssadd))
(ssadd en1 sslist)
(ssadd en2 sslist)
(ssadd en3 sslist)
(ssadd en4 sslist)
(ssadd en5 sslist)
(emkblk sslist pt text )
(princ)
)
;13、entmake生成普通块
;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=92482
;by langjs
(defun emkblk (ss pt name / i)
(setvar "cmdecho" 0)
(entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))
(repeat (setq i (sslength ss)) (entmake (cdr (entget (ssname ss (setq i (1- i)))))))
(entmake '((0 . "ENDBLK")))
(command "_.erase" ss "")
(entmake (list '(0 . "INSERT") (cons 8 "screw") (cons 2 name) (cons 10 pt)))
(setvar "cmdecho" 1)
)
(defun dxf (m dat) (cdr (assoc m dat)))
(defun dxfucs (m dat)(trans (cdr (assoc m dat)) 0 1))
还望明经高手指导，只做了M20以下的，M20以上的很少用
，最后还有点不明白就是，生成同名块，老是显示重定义块，，，有没有更好的方法呢，
这个一般都是固定标准的，所以才用程序生成。或者用其他组合插件
;圆变螺孔 明经 ZZXXQQ 2010.9.8
(defun c:tt ()
(defun mkline (p1 p2 ln)
(entmake (list '(0 . "LINE") (cons 8 ln) (cons 10 p1) (cons 11 p2)))
)
(setvar "CMDECHO" 0)
(if (and (princ "\n选择圆 :")
(setq ss (ssget '((0 . "CIRCLE"))))) (progn
(setq i 0)
(repeat (sslength ss)
(setq en (ssname ss i)
ent (entget en)
i (1+ i)
pc (cdr(assoc 10 ent))
r (cdr(assoc 40 ent))
ri (* r 0.9)
ro (* r 1.1)
pc1 (polar pc 0 ro)
pc2 (polar pc pi ro)
pc3 (polar pc (/ pi 2) ro)
pc4 (polar pc (/ pi -2) ro)
an1 (/ pi 3)
an2 (/ pi -6))
(if (not (tblsearch "LAYER" "CEN"))
(command ".LAYER" "N" "CEN" "C" 1 "CEN" "L" "CENTER2" "CEN" "")
)
(mkline pc1 pc2 "CEN")
(mkline pc3 pc4 "CEN")
(entmake (list '(0 . "CIRCLE") (assoc 8 ent) (cons 10 pc) (cons 40 ri)))
(entmake
(list '(0 . "ARC") (cons 10 pc) (cons 40 r) (cons 50 an1) (cons 51 an2) '(62 . 1))
)
(entdel en)
)
))
(setvar "CMDECHO" 1)
(princ)
)
如果这么做，选择的孔不螺丝孔，而其孔径大小和螺丝的底孔大小完全相同，那不也变成了螺丝空 ZZXXQQ 发表于 2013-4-14 08:33
螺丝是固定大小的吧，标准件，反正我这用的是固定十几种，而你的是遇到圆就变成了螺丝孔， 跟隨須求走.寫的程式.就是好程式.但.Scmtools 說的情況.的確有此可能.!! 所以明知道那幾個孔不是螺絲孔.就要避開.不選取.!! 倒可以再加個圖層.事先分好層.!! 做歸類.再轉換,僅建議.!!
我自己的所有孔類!!都由組立圖.取出.拆不同模板.做不同的視圖自動轉換.!! 跟樓主情況不太一樣.
ScmTools 发表于 2013-4-14 08:52
如果这么做，选择的孔不螺丝孔，而其孔径大小和螺丝的底孔大小完全相同，那不也变成了螺丝空
适合手动选择好螺丝孔，不能框选整个模板让它自动寻找螺丝孔，除非再UG图中做好特征， 支持机械设计的朋友 感谢 邹锋 及 Z版 方享程序! 错误: no function definition: USDXF 很方便的程序!
有参考价值
谢谢 楼主及版主的分享