求助完善螺丝插件
本帖最后由 炸子鸡 于 2018-9-30 10:55 编辑求大神修改，以下是论坛大神发的螺丝插件，根据圆直径生成块，但如果同一尺寸的螺丝孔有实线和虚线同时在就区分不了，希望有大神能完善一下，实线和虚线的螺丝生成不同名字块。
又或者简化一下，只标中心线打上文字M8、M10之类。
附上测试用文件
========================================
(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 "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))
;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))
(defun usdxf (n entt) (cdr(assoc n entt)))
程序好像有问题，运行不了
页:
[1]