设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 原创，圆孔生成镙丝孔
12345下一页
返回列表 发新帖
查看: 9882|回复: 41

[基础] 原创，圆孔生成镙丝孔

    [复制链接]
邹锋
发表于 2013-4-14 04:08 | 显示全部楼层 |阅读模式
本帖最后由 邹锋 于 2013-4-14 04:10 编辑

好久没来，最近闲着无事，练练手，整个LISP ，比较适合做机械朋友使用
由于我们UG转出来的图档里没有标明哪些孔是镙丝孔，哪些是顶针孔，所以需要朋友们去一个个注明， 一套模具有几十个几百个，也挺累的，于是，我就有这个想法了，


  2. (defun c:sww()
  3.   ;----系统变量备份----
  4.   (setvar "cmdecho" 0);_关闭命令提示
  5.   (command "undo" "be")
  6.   (setq osmode_bak (getvar "osmode"));_记录捕捉
  7.   (setvar "osmode" 0);_关闭捕捉
  8.   (setq clayer_bak (getvar "clayer"));_记录当前图层
  9.   (setq cecolor_bak (getvar "cecolor"));_记录当前颜色
  10.   (setq celtype_bak (getvar "celtype"));_记录当前线型
  11.   (setq textstyle_bak (getvar "textstyle"));_记录当前文字样式
  12.   (setq chksty (tblsearch "style" "TXT"))
  13.   (if (= chksty nil)
  14.     (entmake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") (cons 2 "TXT")
  15.        '(70 . 0) (cons 40 1) (cons 41 1) '(3 . "txt.shx") '(4 . "gbcbig.shx")
  16.     )
  17.   )
  18.     )
  19.   (setq chklty (tblsearch "LTYPE" "CENTER"))
  20.   (if (= chklty nil)
  21.     (entmake (list '(0 . "LTYPE") '(100 . "AcDbSymbolTableRecord")  '(100 . "AcDbLinetypeTableRecord")
  22.        (cons 2 "CENTER")  '(3 . "Center ____ _ ____ _ ____ _ ____ _ ____ _ ____")
  23.        '(70 . 0)  '(73 . 2) '(40 . 15.0) '(49 . 10.0)  '(74 . 0) '(49 . -5.0) '(74 . 0)
  24.        )
  25.        )
  26.     )
  27.   (setq ss (ssget '((0 . "CIRCLE")))
  28.        i  0)
  29.   (repeat (sslength ss)
  30.    (setq ename (ssname ss i)
  31.          dat (entget ename)
  32.          pt (usdxf 10 dat)
  33.          r (dxf 40 dat)
  34.    cel (dxf 6 dat)
  35.    D (* R 2)
  36.    )
  37.     (if (or (= cel "DASHED") (= cel "HIDDEN"))
  38.       (setq cel "HIDDEN")
  39.       (setq cel "Continuous")
  40.       )
  41.     (cond ((= d  2.5)
  42.      (setq text "M3")
  43.      (setq xk 0.06)
  44.      (setq mr 1.5)
  45.      (makent)
  46.      )
  47.     ((= d 3.3)
  48.      (setq text "M4")
  49.      (setq xk 0.08)
  50.      (setq mr 2)
  51.      (makent)
  52.     )
  53.     ((= d 4.2)
  54.      (setq text "M5")
  55.      (setq xk 0.1)
  56.      (setq mr 2.5)
  57.      (makent)
  58.      )
  59.     ((= d 5)
  60.      (setq text "M6")
  61.      (setq xk 0.12)
  62.      (setq mr 3)
  63.      (makent)
  64.      )
  65.     ((= d 6.8)
  66.      (setq text "M8")
  67.      (setq xk 0.16)
  68.      (setq mr 4)
  69.      (makent)
  70.      )
  71.     ((= d 8.5)
  72.      (setq text "M10")
  73.      (setq xk 0.2)
  74.      (setq mr 5)
  75.      (makent)
  76.      )
  77.     ((= d 10.5)
  78.      (setq text "M12")
  79.      (setq xk 0.24)
  80.      (setq mr 6)
  81.      (makent)
  82.      )
  83.     ((= d 12)
  84.      (setq text "M14")
  85.      (setq xk 0.28)
  86.      (setq mr 7)
  87.      (makent)
  88.      )
  89.     ((= d 14)
  90.      (setq text "M16")
  91.      (setq xk 0.32)
  92.      (setq mr 8)
  93.      (makent)
  94.      )
  95.     ((= d 15.5)
  96.      (setq text "M18")
  97.      (setq xk 0.36)
  98.      (setq mr 9)
  99.      (makent)
  100.      )
  101.     ((= d 17.5)
  102.      (setq text "M20")
  103.      (setq xk 0.4)
  104.      (setq mr 10)
  105.      (makent)
  106.      )
  107.     )
  108.     (setq i (1+ i))
  109.    )
  110.   ;----系统变量还原----
  111.   (setvar "osmode" osmode_bak);_还原捕捉
  112.   (setvar "clayer" clayer_bak);_还原图层
  113.   (setvar "cecolor" cecolor_bak);_还原颜色
  114.   (setvar "celtype" celtype_bak);_还原线型
  115.   (setvar "textstyle" textstyle_bak);_还原文字样式
  116.   (command "undo" "e")
  117.   (setvar "cmdecho" 1);_打开命令提示
  118.   (princ);_关闭程序返回值
  119.   )

  121. (defun makent ()
  122.   ;;;计算点
  123.   (setq dist (* mr 1.1))
  124.   (setq texth (* mr 0.4))
  125.   (setq pt1 (polar pt 0 dist))
  126.   (setq pt2 (polar pt (* PI 0.5) dist))
  127.   (setq pt3 (polar pt pi dist))
  128.   (setq pt4 (polar pt (* 1.5 pi) dist))
  129.   (setq tept1 (polar pt pi (* mr 2 0.17)))
  130.   (setq textpt (polar tept1 (* 1.5 pi) (* mr 2 0.25)))
  131.   
  132.   ;生成圆
  133.   (entmake (list (cons 0 "CIRCLE")
  134.      (cons 67 0)
  135.      (CONS 62 33)
  136.      (cons 8 "screw")
  137.      (cons 6  cel)
  138.      (cons 48 xk)
  139.      (cons 10 pt)
  140.      (cons 40 r)
  141.      )
  142.      )
  143.   (setq en1 (entlast))
  144.   ;生成中心线
  145.   (entmake (list (cons 0 "LINE")
  146.      (cons 8 "screw")
  147.      (CONS 62 1)
  148.      (cons 6  "CENTER")
  149.      (cons 48 xk)
  150.      (cons 10 pt1)
  151.      (cons 11 pt3)
  152.       )
  153.       )
  154.   (setq en2 (entlast))
  155.   ;生成中心线
  156.   (entmake (list (cons 0 "LINE")
  157.      (cons 8 "screw")
  158.      (CONS 62 1)
  159.      (cons 6  "CENTER")
  160.      (cons 48 xk)
  161.      (cons 10 pt2)
  162.      (cons 11 pt4)
  163.       )
  164.       )
  165.   (setq en3 (entlast))
  166.   ;生成圆弧
  167.   (entmake (list (cons 0 "ARC")
  168.      (cons 8 "screw")
  169.      (CONS 62 92)
  170.      (cons 6 cel)
  171.      (cons 48 xk)
  172.      (cons 10 pt)
  173.      (cons 40 mr)
  174.      (list 210 0.0 0.0 1.0)
  175.      (cons 50 4.71239)
  176.      (cons 51 3.14159)
  177.       )
  178.       )
  179.   (setq en4 (entlast))
  180.   ;;;生成文字
  181.   (entmake (list (cons 0 "TEXT")
  182.      (cons 8 "screw")
  183.      (CONS 62 6)
  184.      (cons 10 textpt)
  185.      (cons 40 texth)
  186.      (cons 1 text)
  187.      (cons 7 "TXT")
  188.      (cons 41 1)
  189.      (cons 51 0.0)
  190.      (cons 71 0)
  191.      (cons 72 0)
  192.      (cons 73 0)
  193.      (list 210 0.0 0.0 1.0)
  194.       )
  195.       )
  196.   (setq en5 (entlast))
  197.   ;;;做成块
  198.   (setq sslist (ssadd))
  199.   (ssadd en1 sslist)
  200.   (ssadd en2 sslist)
  201.   (ssadd en3 sslist)
  202.   (ssadd en4 sslist)
  203.   (ssadd en5 sslist)
  204.   (emkblk sslist pt text )
  205.   (princ)
  206.   )

  208. ;13、entmake生成普通块
  209. ;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=92482
  210. ;by langjs
  211. (defun emkblk (ss pt name / i)
  212.   (setvar "cmdecho" 0)
  213.   (entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))
  214.   (repeat (setq i (sslength ss))    (entmake (cdr (entget (ssname ss (setq i (1- i))))))  )
  215.   (entmake '((0 . "ENDBLK")))
  216.   (command "_.erase" ss "")
  217.   (entmake (list '(0 . "INSERT") (cons 8 "screw") (cons 2 name) (cons 10 pt)))
  218.   (setvar "cmdecho" 1)
  219. )

  221. (defun dxf (m dat) (cdr (assoc m dat)))
  222. (defun dxfucs (m dat)  (trans (cdr (assoc m dat)) 0 1))



还望明经高手指导，只做了M20以下的，M20以上的很少用
，最后还有点不明白就是，生成同名块，老是显示重定义块，，，有没有更好的方法呢，

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x

点评

炸子鸡
楼主请问怎样只实现加上中心线和文字！！！！支持框选!  发表于 2015-11-26 09:34
wayne_myles
请继续研究竖直的螺丝孔标记，实现类似功能  发表于 2015-7-16 07:45
"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

zhangcan0515
发表于 2020-10-28 20:27 | 显示全部楼层
这个一般都是固定标准的，所以才用程序生成。或者用其他组合插件
回复 支持 反对

使用道具 举报

ZZXXQQ
发表于 2013-4-14 08:33 | 显示全部楼层
  1. ;圆变螺孔 明经 ZZXXQQ 2010.9.8
  2. (defun c:tt ()
  3. (defun mkline (p1 p2 ln)
  4.   (entmake (list '(0 . "LINE") (cons 8 ln) (cons 10 p1) (cons 11 p2)))
  5. )
  6. (setvar "CMDECHO" 0)
  7. (if (and (princ "\n选择圆 :")
  8.           (setq ss (ssget '((0 . "CIRCLE"))))) (progn
  9.   (setq i 0)
  10.   (repeat (sslength ss)
  11.    (setq en (ssname ss i)
  12.          ent (entget en)
  13.          i (1+ i)
  14.          pc (cdr(assoc 10 ent))
  15.          r (cdr(assoc 40 ent))
  16.          ri (* r 0.9)
  17.          ro (* r 1.1)
  18.          pc1 (polar pc 0 ro)
  19.          pc2 (polar pc pi ro)
  20.          pc3 (polar pc (/ pi 2) ro)
  21.          pc4 (polar pc (/ pi -2) ro)
  22.          an1 (/ pi 3)
  23.          an2 (/ pi -6))
  24.    (if (not (tblsearch "LAYER" "CEN"))
  25.     (command ".LAYER" "N" "CEN" "C" 1 "CEN" "L" "CENTER2" "CEN" "")
  26.    )
  27.    (mkline pc1 pc2 "CEN")
  28.    (mkline pc3 pc4 "CEN")
  29.    (entmake (list '(0 . "CIRCLE") (assoc 8 ent) (cons 10 pc) (cons 40 ri)))
  30.    (entmake
  31.     (list '(0 . "ARC") (cons 10 pc) (cons 40 r) (cons 50 an1) (cons 51 an2) '(62 . 1))
  32.    )
  33.    (entdel en)
  34.   )
  35. ))
  36. (setvar "CMDECHO" 1)
  37. (princ)
  38. )
回复 支持 反对

使用道具 举报

ScmTools
发表于 2013-4-14 08:52 | 显示全部楼层
如果这么做，选择的孔不螺丝孔，而其孔径大小和螺丝的底孔大小完全相同，那不也变成了螺丝空
回复 支持 反对

使用道具 举报

邹锋
 楼主| 发表于 2013-4-14 09:36 来自手机 | 显示全部楼层
ZZXXQQ 发表于 2013-4-14 08:33

螺丝是固定大小的吧，标准件，反正我这用的是固定十几种，而你的是遇到圆就变成了螺丝孔，
回复 支持 反对

使用道具 举报

shenhung
发表于 2013-4-14 09:38 | 显示全部楼层
跟隨須求走.寫的程式.就是好程式.但.Scmtools 說的情況.的確有此可能.!! 所以明知道那幾個孔不是螺絲孔.就要避開.不選取.!! 倒可以再加個圖層.事先分好層.!! 做歸類.再轉換,僅建議.!!

我自己的所有孔類!!都由組立圖.取出.拆不同模板.做不同的視圖自動轉換.!! 跟樓主情況不太一樣.
回复 支持 反对

使用道具 举报

邹锋
 楼主| 发表于 2013-4-14 09:40 来自手机 | 显示全部楼层
ScmTools 发表于 2013-4-14 08:52
如果这么做，选择的孔不螺丝孔，而其孔径大小和螺丝的底孔大小完全相同，那不也变成了螺丝空

适合手动选择好螺丝孔，不能框选整个模板让它自动寻找螺丝孔，除非再UG图中做好特征，
回复 支持 反对

使用道具 举报

USER2128
发表于 2013-4-14 09:58 | 显示全部楼层
支持机械设计的朋友
回复 支持 反对

使用道具 举报

yoyoho
发表于 2013-4-14 11:29 | 显示全部楼层
感谢 邹锋 及 Z版 方享程序!
回复 支持 反对

使用道具 举报

1993063
发表于 2013-4-14 19:48 | 显示全部楼层
错误: no function definition: USDXF

点评

ZZXXQQ
(defun usdxf (n entt) (cdr(assoc n entt)))  发表于 2013-4-15 21:25
回复 支持 反对

使用道具 举报

lincctw_ccl
发表于 2013-4-15 00:57 | 显示全部楼层
很方便的程序!
有参考价值
谢谢 楼主及版主的分享
回复 支持 反对

使用道具 举报

12345下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-5-3 15:38 , Processed in 0.266341 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表