线割外形穿线孔绘制

ninja37

xyp1964 发表于 2022-5-15 14:13

就是这种效果

linheyuanpcb

ninja37 发表于 2022-5-15 21:49
就是这种效果

(entmakex (list '(0 . "CIRCLE") (cons 10 P5) (cons 40 R)))
(command "line" P5 p4  "");在这个位置加入这句就有引线了

逍遥无声

loveu515

我的2014怎么和燕秀有冲突呀，用了后燕秀就掉了，不知道什么原因

879053410

收藏学习了 感谢楼主

逍遥无声

loveu515

各位帮忙给看看  是怎么回事？
一是退出命令时提示错误：quit / exit abort。这个倒没什么影响。
二是执行完命令后，再新建文件会提示：**express tools**-unable to load acetutil.arx ，必须重启CAD才能解决。

zwq8629

统赢"MH"了解下

andyding

仿写了一个，凑个热闹。

2. (defun c:ac (/ N OLDOR OLDOS P1        P11 P2 P22 P33 P44 PMD PP SS SSNA SSP1 X
   
3.              Y)
   
4.   (setq oldos (getvar "osmode"))
   
5.   (setq oldor (getvar "orthomode"))
   
6.   (defun PickClosePt (obj p);;;多段线所点击点最近的一个顶点
   
7.     (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
   
8.           n  (fix (vlax-curve-getparamatpoint obj pp))
   
9.     )
   
10.     (setq p1 (vlax-curve-getPointAtParam obj n))
    
11.     (setq p2 (vlax-curve-getPointAtParam obj (1+ n)))
    
12.     (if        (< (distance pp p1) (distance pp p2))
    
13.       p1
    
14.       p2
    
15.     )
    
16.   )
    
17.   (princ "\n请选择要画穿线孔的多义线：")
    
18.   (if (and (setq ss (entsel))
    
19.            (= (cdr (assoc 0 (entget (car ss)))) "LWPOLYLINE")
    
20.       )
    
21.     (progn
    
22.       (setvar "osmode" 0)
    
23.       (setvar "orthomode" 1)
    
24.       (setq ssna (vlax-ename->vla-object (car ss)))
    
25.       (setq ssp1 (cadr ss))
    
26.       (setq p11 (PickClosePt ssna ssp1))
    
27.       (setq pmd (mapcar '(lambda (X Y) (* (+ X Y) 0.5)) P1 P2))
    
28.       (cond ((and (= (cadr p11) (cadr pmd)) (> (car p11) (car pmd)))
    
29.              (setq p22 (list (- (car p11) 2.0) (cadr p11)))
    
30.             );;;2.0为起割点距离
    
31.             ((and (= (cadr p11) (cadr pmd)) (< (car p11) (car pmd)))
    
32.              (setq p22 (list (+ (car p11) 2.0) (cadr p11)))
    
33.             )
    
34.             ((and (= (car p11) (car pmd)) (> (cadr p11) (cadr pmd)))
    
35.              (setq p22 (list (car p11) (- (cadr p11) 2.0)))
    
36.             )
    
37.             ((and (= (car p11) (car pmd)) (< (cadr p11) (cadr pmd)))
    
38.              (setq p22 (list (car p11) (+ (cadr p11) 2.0)))
    
39.             )
    
40.       )
    
41.       (princ "\n请选择下一点：")
    
42.       (if (setq p33 (getpoint p22))
    
43.         (progn
    
44.           (cond        ((and (= (cadr p33) (cadr p22)) (> (car p33) (car p22)))
    
45.                  (setq p44 (list (+ (car p22) 2.0) (cadr p22)))
    
46.                 );;;2.0为起割点到穿丝孔距离
    
47.                 ((and (= (cadr p33) (cadr p22)) (< (car p33) (car p22)))
    
48.                  (setq p44 (list (- (car p22) 2.0) (cadr p22)))
    
49.                 )
    
50.                 ((and (= (car p33) (car p22)) (> (cadr p33) (cadr p22)))
    
51.                  (setq p44 (list (car p22) (+ (cadr p22) 2.0)))
    
52.                 )
    
53.                 ((and (= (car p33) (car p22)) (< (cadr p33) (cadr p22)))
    
54.                  (setq p44 (list (car p22) (- (cadr p22) 2.0)))
    
55.                 )
    
56.           )
    
57.           (entmake
    
58.             (list '(0 . "LINE") (cons 10 p22) (cons 11 p44) (cons 62 1))
    
59.           )
    
60.           (entmake (list '(0 . "Circle")
    
61.                          (cons 10 p44)
    
62.                          (cons 40 0.5);;;0.5为穿丝孔半径
    
63.                          (cons 62 1)
    
64.                    )
    
65.           )
    
66.           (setvar "osmode" oldos)
    
67.           (setvar "orthomode" oldor)
    
68.         )
    
69.         (progn (princ "\n未选择到点，程序结束!")
    
70.                (setvar "osmode" oldos)
    
71.                (setvar "orthomode" oldor)
    
72.         )
    
73.       )
    
74.     )
    
75.     (progn (princ "\n未选择到图形或图形不是多义线,程序结束!")
    
76.            (setvar "osmode" oldos)
    
77.            (setvar "orthomode" oldor)
    
78.     )
    
79.   )
    
80.   (princ)
    
81. )

(defun c:ac (/ N OLDOR OLDOS P1        P11 P2 P22 P33 P44 PMD PP SS SSNA SSP1 X<br />              Y)<br />   (setq oldos (getvar "osmode"))<br />   (setq oldor (getvar "orthomode"))<br />   (defun PickClosePt (obj p);;;多段线所点击点最近的一个顶点<br />     (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))<br />           n  (fix (vlax-curve-getparamatpoint obj pp))<br />     )<br />     (setq p1 (vlax-curve-getPointAtParam obj n))<br />     (setq p2 (vlax-curve-getPointAtParam obj (1+ n)))<br />     (if        (< (distance pp p1) (distance pp p2))<br />       p1<br />       p2<br />     )<br />   )<br />   (princ "\n请选择要画穿线孔的多义线：")<br />   (if (and (setq ss (entsel))<br />            (= (cdr (assoc 0 (entget (car ss)))) "LWPOLYLINE")<br />       )<br />     (progn<br />       (setvar "osmode" 0)<br />       (setvar "orthomode" 1)<br />       (setq ssna (vlax-ename->vla-object (car ss)))<br />       (setq ssp1 (cadr ss))<br />       (setq p11 (PickClosePt ssna ssp1))<br />       (setq pmd (mapcar '(lambda (X Y) (* (+ X Y) 0.5)) P1 P2))<br />       (cond ((and (= (cadr p11) (cadr pmd)) (> (car p11) (car pmd)))<br />              (setq p22 (list (- (car p11) 2.0) (cadr p11)))<br />             );;;2.0为起割点距离<br />             ((and (= (cadr p11) (cadr pmd)) (< (car p11) (car pmd)))<br />              (setq p22 (list (+ (car p11) 2.0) (cadr p11)))<br />             )<br />             ((and (= (car p11) (car pmd)) (> (cadr p11) (cadr pmd)))<br />              (setq p22 (list (car p11) (- (cadr p11) 2.0)))<br />             )<br />             ((and (= (car p11) (car pmd)) (< (cadr p11) (cadr pmd)))<br />              (setq p22 (list (car p11) (+ (cadr p11) 2.0)))<br />             )<br />       )<br />       (princ "\n请选择下一点：")<br />       (if (setq p33 (getpoint p22))<br />         (progn<br />           (cond        ((and (= (cadr p33) (cadr p22)) (> (car p33) (car p22)))<br />                  (setq p44 (list (+ (car p22) 2.0) (cadr p22)))<br />                 );;;2.0为起割点到穿丝孔距离<br />                 ((and (= (cadr p33) (cadr p22)) (< (car p33) (car p22)))<br />                  (setq p44 (list (- (car p22) 2.0) (cadr p22)))<br />                 )<br />                 ((and (= (car p33) (car p22)) (> (cadr p33) (cadr p22)))<br />                  (setq p44 (list (car p22) (+ (cadr p22) 2.0)))<br />                 )<br />                 ((and (= (car p33) (car p22)) (< (cadr p33) (cadr p22)))<br />                  (setq p44 (list (car p22) (- (cadr p22) 2.0)))<br />                 )<br />           )<br />           (entmake<br />             (list '(0 . "LINE") (cons 10 p22) (cons 11 p44) (cons 62 1))<br />           )<br />           (entmake (list '(0 . "Circle")<br />                          (cons 10 p44)<br />                          (cons 40 0.5);;;0.5为穿丝孔半径<br />                          (cons 62 1)<br />                    )<br />           )<br />           (setvar "osmode" oldos)<br />           (setvar "orthomode" oldor)<br />         )<br />         (progn (princ "\n未选择到点，程序结束!")<br />                (setvar "osmode" oldos)<br />                (setvar "orthomode" oldor)<br />         )<br />       )<br />     )<br />     (progn (princ "\n未选择到图形或图形不是多义线,程序结束!")<br />            (setvar "osmode" oldos)<br />            (setvar "orthomode" oldor)<br />     )<br />   )<br />   (princ)<br /> )

loveu515

andyding 发表于 2023-7-3 21:06
仿写了一个，凑个热闹。

感谢分享这么好的代码