求CAD中拾取两个点生成沉孔侧视图的lisp程序

xiaobailou

图片说明:
1.只需要拾取两个点；
2.输入沉头直径D，沉头深度t，通孔直径d；
3.生成沉头孔侧视图。


谢谢了！

嘒彼小星

xiaobailou 发表于 2024-8-22 12:31
谢谢，加载后运行不了。

下载这个，ap加载或者拖到绘图区，命令T1

lijiao

建议你使用机械版的autocad

xiaobailou

lijiao 发表于 2024-8-18 07:34
建议你使用机械版的autocad

谢谢你的建议

paulpipi

帮顶，希望高手帮忙解决

自贡黄明儒

这个适合内六角螺钉，小d尺寸，机械手册有规定，松配合 紧配合 一般配合。如M6，则d有三种尺寸。

xiaobailou

paulpipi 发表于 2024-8-20 11:52
帮顶，希望高手帮忙解决

多谢支持！

xiaobailou

自贡黄明儒 发表于 2024-8-20 12:02
这个适合内六角螺钉，小d尺寸，机械手册有规定，松配合 紧配合 一般配合。如M6，则d有三种尺寸。

谢谢回复，大D和小d尺寸可以根据自己需要的值输入即可。

嘒彼小星

看看是不是这个意思的。

1. (defun c:tT(/ pt1 pt2 dis1_2 ang1_2 dia dep td 1_1 1_2 1_3 1_4 2_1 2_2 2_3 2_4);沉孔侧视图
   
2.   (command "UNDO" "BE")
   
3.   (setq pt1(getpoint "\n指定头部中点") pt2(getpoint pt1 "\n指定孔底中点"))
   
4.   (setq dis1_2(distance pt1 pt2) ang1_2(angle pt2 pt1))
   
5.   (setq dia(getdist "\n沉头直径D<默认12>") dep(getdist "\n沉头深度t<默认4>") td(getdist "\n通孔直径d<默认8>"))
   
6.   (if(<= dia 0)(setq dia 12))(if(<= dep 0)(setq dep 4))(if(<= td 0)(setq td 8))
   
7.   (if (> dis1_2 0)
   
8.     (progn
   
9.       (if (> dis1_2 dep)
   
10.         (progn
    
11.           (setq 1_1(polar pt1 (- ang1_2 (* pi 0.5)) (/ dia 2)));以下1234对应头部右上顶点起顺时针
    
12.           (setq 1_2(polar 1_1 (+ ang1_2 pi) dep))
    
13.           (setq 1_3(polar 1_2 (+ ang1_2 (* pi 0.5)) dia))
    
14.           (setq 1_4(polar 1_3 ang1_2 dep))
    
15.           (setq 2_1(polar pt2 (- ang1_2 (* pi 0.5)) (/ td 2)));以下1234对应底部右下顶点起逆时针
    
16.           (setq 2_2(polar 2_1 ang1_2 (- dis1_2 dep)))
    
17.           (setq 2_3(polar 2_2 (+ ang1_2 (* pi 0.5)) td))
    
18.           (setq 2_4(polar 2_3 (+ ang1_2 pi) (- dis1_2 dep)))
    
19.           (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) (cons 10 1_1) (cons 10 1_2)(cons 10 1_3)(cons 10 1_4)))
    
20.           (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) (cons 10 2_1) (cons 10 2_2)(cons 10 2_3)(cons 10 2_4)))
    
21.         )(progn (princ "\n重新输入沉头深度t或者重新指定顶点或底点"))
    
22.       )
    
23.     )(progn (princ "\n重新指定顶点或者底点"))
    
24.   )
    
25.   (command "UNDO" "E")
    
26.   (princ)
    
27. )

(defun c:tT(/ pt1 pt2 dis1_2 ang1_2 dia dep td 1_1 1_2 1_3 1_4 2_1 2_2 2_3 2_4);沉孔侧视图<br />   (command "UNDO" "BE")<br />   (setq pt1(getpoint "\n指定头部中点") pt2(getpoint pt1 "\n指定孔底中点"))<br />   (setq dis1_2(distance pt1 pt2) ang1_2(angle pt2 pt1))<br />   (setq dia(getdist "\n沉头直径D<默认12>") dep(getdist "\n沉头深度t<默认4>") td(getdist "\n通孔直径d<默认8>"))<br />   (if(<= dia 0)(setq dia 12))(if(<= dep 0)(setq dep 4))(if(<= td 0)(setq td 8))<br />   (if (> dis1_2 0)<br />     (progn <br />       (if (> dis1_2 dep)<br />         (progn<br />           (setq 1_1(polar pt1 (- ang1_2 (* pi 0.5)) (/ dia 2)));以下1234对应头部右上顶点起顺时针<br />           (setq 1_2(polar 1_1 (+ ang1_2 pi) dep))<br />           (setq 1_3(polar 1_2 (+ ang1_2 (* pi 0.5)) dia))<br />           (setq 1_4(polar 1_3 ang1_2 dep))<br />           (setq 2_1(polar pt2 (- ang1_2 (* pi 0.5)) (/ td 2)));以下1234对应底部右下顶点起逆时针<br />           (setq 2_2(polar 2_1 ang1_2 (- dis1_2 dep)))<br />           (setq 2_3(polar 2_2 (+ ang1_2 (* pi 0.5)) td))<br />           (setq 2_4(polar 2_3 (+ ang1_2 pi) (- dis1_2 dep)))<br />           (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) (cons 10 1_1) (cons 10 1_2)(cons 10 1_3)(cons 10 1_4)))<br />           (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) (cons 10 2_1) (cons 10 2_2)(cons 10 2_3)(cons 10 2_4)))<br />         )(progn (princ "\n重新输入沉头深度t或者重新指定顶点或底点"))<br />       )<br />     )(progn (princ "\n重新指定顶点或者底点"))<br />   )<br />   (command "UNDO" "E")<br />   (princ)<br /> )

xiaobailou

嘒彼小星 发表于 2024-8-21 12:47
看看是不是这个意思的。

谢谢，加载后运行不了。