分享一个可以画斜线15°外廓线的代码

Qwer1243

在放样水撑和柱撑详图的过程中可能会用到，有需要的可以看一下；有优化意见的欢迎分享

感谢黄明儒大师提供的界面函数和优化思路，下面代码已更新，增加了参数界面，水平线和竖直线也已适用

2. (defun C:e7 (/ dialog getdata setdata do1 DCLID FN FNAME)
   
3.   (defun dialog        ()
   
4.     (setq fname (vl-filename-mktemp nil nil ".dcl"))
   
5.     (setq fn (open fname "w"))
   
6.     (write-line        "HHbianban : dialog{label="连接板放样";"
   
7.                 fn
   
8.     )
   
9.     (write-line        " :edit_box{label="边距 (mm)";key="key1";value="20";}"
   
10.                 fn
    
11.     )
    
12.     (write-line        " :edit_box{label="角度(mm)";key="key2";value="15";}"
    
13.                 fn
    
14.     )
    
15.     (write-line        " :edit_box{label="距离端线长度";key="key3";value="100";}"
    
16.                 fn
    
17.     )
    
18.     (write-line " ok_cancel;" fn)
    
19.     (write-line "  }" fn)
    
20.     (close fn)
    
21.   )
    
22.   
    
23.   (defun getdata (/ DCLDATA I KEY)
    
24.     (setq i 0)
    
25.     (repeat 3                                                    ;"key1"到"key5"
    
26.       (setq i (1+ i))
    
27.       (setq key (strcat "key" (itoa i)))
    
28.       (set (read key) (get_tile key))
    
29.       (setq DCLData (cons (cons key (eval (read key))) DCLData))
    
30.     )
    
31.     (Setenv "HHbianban" (VL-PRIN1-TO-STRING DCLData))
    
32.   )
    
33.   
    
34.   (defun setdata (/ DCLDATA X)
    
35.     (cond ((setq DCLData (getenv "HHbianban"))
    
36.            (setq DCLData (read DCLData))
    
37.            (mapcar '(lambda (x) (Set_tile (car x) (cdr x))) DCLData)
    
38.           )
    
39.     )
    
40.   )
    
41.   
    
42.   (defun do1 (/ ang c data line m m_perp numb1 numb2 numb3 pt pt1 pt2 pt3 pt4 x x1 x2 y_proj y1 y2)
    
43.     (setvar "cmdecho" 0)
    
44.     (while (setq line (entsel "\n选择直线: "))
    
45.       (setq pt (getpoint "\n请指定方向: "))
    
46.       (setq data (entget (car line)))
    
47.       (setq x1 (cadr (assoc 10 data)) x2 (cadr (assoc 11 data)) y1 (caddr (assoc 10 data)) y2 (caddr (assoc 11 data)))
    
48.       
    
49.       ;;读取面板数值
    
50.       (setq numb1 (atof key1) numb2 (atof key2) numb3 (atof key3))
    
51.       
    
52.       ;;选择直线为水平线
    
53.       (if (= y1 y2)
    
54.         (progn
    
55.           (princ "\n为水平线")
    
56.           (setq ang (/ pi 2))
    
57.           (if (< x1 x2)
    
58.             (progn
    
59.               (setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点
    
60.               (setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)
    
61.             )
    
62.             (progn
    
63.               (setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点
    
64.               (setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)
    
65.             )
    
66.           )
    
67.           (if (> (cadr pt) y1)
    
68.             (progn
    
69.               (princ "\n点在直线上方。")
    
70.               (setq pt1 (polar pt1 (* pi (/ 270 180.0)) numb3)) ;远离端线
    
71.               (setq pt2 (polar pt2 (* pi (/ 270 180.0)) numb3)) ;远离端线
    
72.               (setq pt1 (polar pt1 (* pi (/ 180 180.0)) numb1)) ;边距
    
73.               (setq pt2 (polar pt2 (* pi (/ 0 180.0)) numb1)) ;边距
    
74.               (setq pt3 (polar pt1 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
    
75.               (setq pt4 (polar pt2 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
    
76.             )
    
77.             (progn
    
78.               (princ "\n点在直线下方。")
    
79.               (setq pt1 (polar pt1 (* pi (/ 90 180.0)) numb3)) ;远离端线
    
80.               (setq pt2 (polar pt2 (* pi (/ 90 180.0)) numb3)) ;远离端线
    
81.               (setq pt1 (polar pt1 (* pi (/ 180 180.0)) numb1)) ;边距
    
82.               (setq pt2 (polar pt2 (* pi (/ 0 180.0)) numb1)) ;边距
    
83.               (setq pt3 (polar pt1 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
    
84.               (setq pt4 (polar pt2 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
    
85.             )
    
86.           )
    
87.         )
    
88.       )
    
89.       
    
90.       ;;选择直线为竖直线
    
91.       (if (= x1 x2)
    
92.         (progn
    
93.           (princ "\n为竖直线")
    
94.           (setq ang 0)
    
95.           (if (< y1 y2)
    
96.             (progn
    
97.               (setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点
    
98.               (setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)
    
99.             )
    
100.             (progn
     
101.               (setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点
     
102.               (setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)
     
103.             )
     
104.           )
     
105.           (if (> (car pt) x1)
     
106.             (progn
     
107.               (princ "\n点在直线右侧。")
     
108.               (setq pt1 (polar pt1 (* pi (/ 180 180.0)) numb3)) ;远离端线
     
109.               (setq pt2 (polar pt2 (* pi (/ 180 180.0)) numb3)) ;远离端线
     
110.               (setq pt1 (polar pt1 (* pi (/ 270 180.0)) numb1)) ;边距
     
111.               (setq pt2 (polar pt2 (* pi (/ 90 180.0)) numb1)) ;边距
     
112.               (setq pt3 (polar pt1 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
     
113.               (setq pt4 (polar pt2 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
     
114.             )
     
115.             (progn
     
116.               (princ "\n点在直线左侧。")
     
117.               (setq pt1 (polar pt1 (* pi (/ 0 180.0)) numb3)) ;远离端线
     
118.               (setq pt2 (polar pt2 (* pi (/ 0 180.0)) numb3)) ;远离端线
     
119.               (setq pt1 (polar pt1 (* pi (/ 270 180.0)) numb1)) ;边距
     
120.               (setq pt2 (polar pt2 (* pi (/ 90 180.0)) numb1)) ;边距
     
121.               (setq pt3 (polar pt1 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
     
122.               (setq pt4 (polar pt2 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
     
123.             )
     
124.           )
     
125.         )
     
126.       )
     
127.       
     
128.       ;;选择直线为斜线
     
129.       (if (and (/= x1 x2) (/= y1 y2))
     
130.         (progn
     
131.           (princ "\n为斜线")
     
132.           (if (< y1 y2)
     
133.             (progn
     
134.               (setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点
     
135.               (setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)
     
136.             )
     
137.             (progn
     
138.               (setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点
     
139.               (setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)
     
140.             )
     
141.           )
     
142.          
     
143.           ; 计算斜率 m 和截距 c
     
144.           (setq m (/ (- (cadr pt2) (cadr pt1)) (- (car pt2) (car pt1))))
     
145.           (setq c (- (cadr pt1) (* m (car pt1))))
     
146.          
     
147.           ; 计算垂直线的斜率
     
148.           (setq m_perp (- (/ 1 m)))
     
149.          
     
150.           ; 计算角度
     
151.           (setq ang (atan m_perp))
     
152.          
     
153.           ;计算点 P 到直线的垂直投影点的 y 坐标
     
154.           (setq x (car pt))
     
155.           (setq y_proj (+ (* m x) c))
     
156.          
     
157.           ;判断点的位置
     
158.           (if (> ang 0)
     
159.             (if (> (cadr pt) y_proj)
     
160.               (progn
     
161.                 (princ "\n点在直线上方。")
     
162.                 (setq pt1 (polar pt1 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线
     
163.                 (setq pt2 (polar pt2 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线
     
164.                 (setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距
     
165.                 (setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距
     
166.                 (setq pt3 (polar pt1 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
     
167.                 (setq pt4 (polar pt2 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
     
168.               )
     
169.               (progn
     
170.                 (princ "\n点在直线下方。")
     
171.                 (setq pt1 (polar pt1 ang numb3)) ;远离端线
     
172.                 (setq pt2 (polar pt2 ang numb3)) ;远离端线
     
173.                 (setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距
     
174.                 (setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距
     
175.                 (setq pt3 (polar pt1 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
     
176.                 (setq pt4 (polar pt2 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
     
177.               )
     
178.             )
     
179.             (if (> (cadr pt) y_proj)
     
180.               (progn
     
181.                 (princ "\n点在直线上方。")
     
182.                 (setq pt1 (polar pt1 ang numb3)) ;远离端线
     
183.                 (setq pt2 (polar pt2 ang numb3)) ;远离端线
     
184.                 (setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距
     
185.                 (setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距
     
186.                 (setq pt3 (polar pt1 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
     
187.                 (setq pt4 (polar pt2 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
     
188.               )
     
189.               (progn
     
190.                 (princ "\n点在直线下方。")
     
191.                 (setq pt1 (polar pt1 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线
     
192.                 (setq pt2 (polar pt2 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线
     
193.                 (setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距
     
194.                 (setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距
     
195.                 (setq pt3 (polar pt1 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
     
196.                 (setq pt4 (polar pt2 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
     
197.               )
     
198.             )
     
199.           )
     
200.         )
     
201.       )
     
202.       
     
203.       (entmakeX (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
     
204.       (entmakeX (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3)))
     
205.       (entmakeX (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4)))
     
206.       (princ "\n~~~~~~~~~~~分割线~~~~~~~~~~~")
     
207.     )
     
208.     (princ return#)
     
209.   )
     
210.   
     
211.   (dialog)
     
212.   (setq dclid (load_dialog fname))
     
213.   (new_dialog "HHbianban" dclid)
     
214.   (setdata)
     
215.   (action_tile "accept" "(getdata)(done_dialog 1)")
     
216.   (action_tile "cancel" "(getdata)(done_dialog 0)")
     
217.   (setq return# (start_dialog))
     
218.   (unload_dialog dclid)
     
219.   (vl-file-delete fname)
     
220.   (cond ((equal return# 1) (do1)))
     
221. )

(defun C:e7 (/ dialog getdata setdata do1 DCLID FN FNAME)<br />   (defun dialog        ()<br />     (setq fname (vl-filename-mktemp nil nil ".dcl"))<br />     (setq fn (open fname "w"))<br />     (write-line        "HHbianban : dialog{label="连接板放样";"<br />                 fn<br />     )<br />     (write-line        " :edit_box{label="边距 (mm)";key="key1";value="20";}"<br />                 fn<br />     )<br />     (write-line        " :edit_box{label="角度(mm)";key="key2";value="15";}"<br />                 fn<br />     )<br />     (write-line        " :edit_box{label="距离端线长度";key="key3";value="100";}"<br />                 fn<br />     )<br />     (write-line " ok_cancel;" fn)<br />     (write-line "  }" fn)<br />     (close fn)<br />   )<br />   <br />   (defun getdata (/ DCLDATA I KEY)<br />     (setq i 0)<br />     (repeat 3                                                    ;"key1"到"key5"<br />       (setq i (1+ i))<br />       (setq key (strcat "key" (itoa i)))<br />       (set (read key) (get_tile key))<br />       (setq DCLData (cons (cons key (eval (read key))) DCLData))<br />     )<br />     (Setenv "HHbianban" (VL-PRIN1-TO-STRING DCLData))<br />   )<br />   <br />   (defun setdata (/ DCLDATA X)<br />     (cond ((setq DCLData (getenv "HHbianban"))<br />            (setq DCLData (read DCLData))<br />            (mapcar '(lambda (x) (Set_tile (car x) (cdr x))) DCLData)<br />           )<br />     )<br />   )<br />   <br />   (defun do1 (/ ang c data line m m_perp numb1 numb2 numb3 pt pt1 pt2 pt3 pt4 x x1 x2 y_proj y1 y2)<br />     (setvar "cmdecho" 0)<br />     (while (setq line (entsel "\n选择直线: "))<br />       (setq pt (getpoint "\n请指定方向: "))<br />       (setq data (entget (car line)))<br />       (setq x1 (cadr (assoc 10 data)) x2 (cadr (assoc 11 data)) y1 (caddr (assoc 10 data)) y2 (caddr (assoc 11 data)))<br />       <br />       ;;读取面板数值<br />       (setq numb1 (atof key1) numb2 (atof key2) numb3 (atof key3))<br />       <br />       ;;选择直线为水平线<br />       (if (= y1 y2)<br />         (progn <br />           (princ "\n为水平线")<br />           (setq ang (/ pi 2))<br />           (if (< x1 x2)<br />             (progn<br />               (setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点<br />               (setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)<br />             )<br />             (progn<br />               (setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点<br />               (setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)<br />             )<br />           )<br />           (if (> (cadr pt) y1)<br />             (progn <br />               (princ "\n点在直线上方。")<br />               (setq pt1 (polar pt1 (* pi (/ 270 180.0)) numb3)) ;远离端线<br />               (setq pt2 (polar pt2 (* pi (/ 270 180.0)) numb3)) ;远离端线<br />               (setq pt1 (polar pt1 (* pi (/ 180 180.0)) numb1)) ;边距<br />               (setq pt2 (polar pt2 (* pi (/ 0 180.0)) numb1)) ;边距<br />               (setq pt3 (polar pt1 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线<br />               (setq pt4 (polar pt2 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线<br />             )<br />             (progn <br />               (princ "\n点在直线下方。")<br />               (setq pt1 (polar pt1 (* pi (/ 90 180.0)) numb3)) ;远离端线<br />               (setq pt2 (polar pt2 (* pi (/ 90 180.0)) numb3)) ;远离端线<br />               (setq pt1 (polar pt1 (* pi (/ 180 180.0)) numb1)) ;边距<br />               (setq pt2 (polar pt2 (* pi (/ 0 180.0)) numb1)) ;边距<br />               (setq pt3 (polar pt1 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线<br />               (setq pt4 (polar pt2 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线<br />             )<br />           )<br />         )<br />       )<br />       <br />       ;;选择直线为竖直线<br />       (if (= x1 x2)<br />         (progn <br />           (princ "\n为竖直线")<br />           (setq ang 0)<br />           (if (< y1 y2)<br />             (progn<br />               (setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点<br />               (setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)<br />             )<br />             (progn<br />               (setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点<br />               (setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)<br />             )<br />           )<br />           (if (> (car pt) x1)<br />             (progn <br />               (princ "\n点在直线右侧。")<br />               (setq pt1 (polar pt1 (* pi (/ 180 180.0)) numb3)) ;远离端线<br />               (setq pt2 (polar pt2 (* pi (/ 180 180.0)) numb3)) ;远离端线<br />               (setq pt1 (polar pt1 (* pi (/ 270 180.0)) numb1)) ;边距<br />               (setq pt2 (polar pt2 (* pi (/ 90 180.0)) numb1)) ;边距<br />               (setq pt3 (polar pt1 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线<br />               (setq pt4 (polar pt2 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线<br />             )<br />             (progn <br />               (princ "\n点在直线左侧。")<br />               (setq pt1 (polar pt1 (* pi (/ 0 180.0)) numb3)) ;远离端线<br />               (setq pt2 (polar pt2 (* pi (/ 0 180.0)) numb3)) ;远离端线<br />               (setq pt1 (polar pt1 (* pi (/ 270 180.0)) numb1)) ;边距<br />               (setq pt2 (polar pt2 (* pi (/ 90 180.0)) numb1)) ;边距<br />               (setq pt3 (polar pt1 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线<br />               (setq pt4 (polar pt2 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线<br />             )<br />           )<br />         )<br />       )<br />       <br />       ;;选择直线为斜线<br />       (if (and (/= x1 x2) (/= y1 y2))<br />         (progn<br />           (princ "\n为斜线")<br />           (if (< y1 y2)<br />             (progn<br />               (setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点<br />               (setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)<br />             )<br />             (progn<br />               (setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点<br />               (setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)<br />             )<br />           )<br />           <br />           ; 计算斜率 m 和截距 c<br />           (setq m (/ (- (cadr pt2) (cadr pt1)) (- (car pt2) (car pt1))))<br />           (setq c (- (cadr pt1) (* m (car pt1))))<br />           <br />           ; 计算垂直线的斜率<br />           (setq m_perp (- (/ 1 m)))<br />           <br />           ; 计算角度<br />           (setq ang (atan m_perp))<br />           <br />           ;计算点 P 到直线的垂直投影点的 y 坐标<br />           (setq x (car pt))<br />           (setq y_proj (+ (* m x) c))<br />           <br />           ;判断点的位置<br />           (if (> ang 0)<br />             (if (> (cadr pt) y_proj)<br />               (progn <br />                 (princ "\n点在直线上方。")<br />                 (setq pt1 (polar pt1 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线<br />                 (setq pt2 (polar pt2 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线<br />                 (setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距<br />                 (setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距<br />                 (setq pt3 (polar pt1 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线<br />                 (setq pt4 (polar pt2 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线<br />               )<br />               (progn <br />                 (princ "\n点在直线下方。")<br />                 (setq pt1 (polar pt1 ang numb3)) ;远离端线<br />                 (setq pt2 (polar pt2 ang numb3)) ;远离端线<br />                 (setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距<br />                 (setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距<br />                 (setq pt3 (polar pt1 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线<br />                 (setq pt4 (polar pt2 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线<br />               )<br />             )<br />             (if (> (cadr pt) y_proj)<br />               (progn <br />                 (princ "\n点在直线上方。")<br />                 (setq pt1 (polar pt1 ang numb3)) ;远离端线<br />                 (setq pt2 (polar pt2 ang numb3)) ;远离端线<br />                 (setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距<br />                 (setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距<br />                 (setq pt3 (polar pt1 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线<br />                 (setq pt4 (polar pt2 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线<br />               )<br />               (progn <br />                 (princ "\n点在直线下方。")<br />                 (setq pt1 (polar pt1 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线<br />                 (setq pt2 (polar pt2 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线<br />                 (setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距<br />                 (setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距<br />                 (setq pt3 (polar pt1 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线<br />                 (setq pt4 (polar pt2 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线<br />               )<br />             )<br />           )<br />         )<br />       )<br />       <br />       (entmakeX (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))<br />       (entmakeX (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3)))<br />       (entmakeX (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4)))<br />       (princ "\n~~~~~~~~~~~分割线~~~~~~~~~~~")<br />     )<br />     (princ return#)<br />   )<br />   <br />   (dialog)<br />   (setq dclid (load_dialog fname))<br />   (new_dialog "HHbianban" dclid)<br />   (setdata)<br />   (action_tile "accept" "(getdata)(done_dialog 1)")<br />   (action_tile "cancel" "(getdata)(done_dialog 0)")<br />   (setq return# (start_dialog))<br />   (unload_dialog dclid)<br />   (vl-file-delete fname)<br />   (cond ((equal return# 1) (do1)))<br /> )

自贡黄明儒

Qwer1243 发表于 2024-9-24 11:45
我不会做面板，你要是方便的话可以帮忙更新一下面板，我刚才重新上传了代码，水平和竖直线不会报错了

1. (defun C:Ban (/ dialog getdata setdata do1 DCLID FN FNAME)
   
2.   (defun dialog        ()
   
3.     (setq fname (vl-filename-mktemp nil nil ".dcl"))
   
4.     (setq fn (open fname "w"))
   
5.     (write-line        "HHbianban : dialog{label=\"画边板 黄明儒\";"
   
6.                 fn
   
7.     )
   
8.     (write-line        " :edit_box{label=\"边距 (mm)\";key=\"key1\";value=\"20\";}"
   
9.                 fn
   
10.     )
    
11.     (write-line        " :edit_box{label=\"角度(mm)\";key=\"key2\";value=\"15\";}"
    
12.                 fn
    
13.     )
    
14.     (write-line        " :edit_box{label=\"离端部 倍数\";key=\"key3\";value=\"1.5\";}"
    
15.                 fn
    
16.     )
    
17.     (write-line " ok_cancel;" fn)
    
18.     (write-line "  }" fn)
    
19.     (close fn)
    
20.   )
    
21. 
    
22.   (defun getdata (/ DCLDATA I KEY)
    
23.     (setq i 0)
    
24.     (repeat 3                                                    ;"key1"到"key5"
    
25.       (setq i (1+ i))
    
26.       (setq key (strcat "key" (itoa i)))
    
27.       (set (read key) (get_tile key))
    
28.       (setq DCLData (cons (cons key (eval (read key))) DCLData))
    
29.     )
    
30.     (Setenv "HHbianban" (VL-PRIN1-TO-STRING DCLData))
    
31.   )
    
32. 
    
33.   (defun setdata (/ DCLDATA X)
    
34.     (cond ((setq DCLData (getenv "HHbianban"))
    
35.            (setq DCLData (read DCLData))
    
36.            (mapcar '(lambda (x) (Set_tile (car x) (cdr x))) DCLData)
    
37.           )
    
38.     )
    
39.   )
    
40. 
    
41.    (defun do1 ()
    
42.     (ACET-UNDO-BEGIN)                                            ;编组
    
43.     (setq e0 (entlast))
    
44.     (if        (setq e (entsel "\n 型钢端线:"))
    
45.       (progn
    
46.         (setq p0 (cadr e))
    
47.         (setq obj (vlax-ename->vla-object (car e)))
    
48.         (setq key3 (* (distof key3) (vlax-get obj 'length)))
    
49.         (setq key3 (VL-PRINC-TO-STRING key3))
    
50.         (vl-cmdf "_offset" key3 e pause "")
    
51.       )
    
52.     )
    
53.     ;;如果偏移成功
    
54.     (setq e (entlast))
    
55.     (if        (not (equal e e0))
    
56.       (do2 e)
    
57.     )
    
58.     (ACET-UNDO-END)
    
59.   )
    
60. 
    
61. 
    
62.   ;;与PPCAD保持一致
    
63.   (if (not (tblsearch "layer" "4虚线层"))
    
64.     (vl-cmdf "_layer" "_M" "4虚线层" "_C" 6 "" "L" "DASHED" "" "")
    
65.   )
    
66. 
    
67.   (dialog)
    
68.   (setq dclid (load_dialog fname))
    
69.   (new_dialog "HHbianban" dclid)
    
70.   (setdata)
    
71.   (action_tile "accept" "(getdata)(done_dialog 1)")
    
72.   (action_tile "cancel" "(getdata)(done_dialog 0)")
    
73.   (setq return# (start_dialog))
    
74.   (unload_dialog dclid)
    
75.   (vl-file-delete fname)
    
76.   (cond ((equal return# 1) (do1)))
    
77. )
    

(defun C:Ban (/ dialog getdata setdata do1 DCLID FN FNAME)<br />   (defun dialog        ()<br />     (setq fname (vl-filename-mktemp nil nil ".dcl"))<br />     (setq fn (open fname "w"))<br />     (write-line        "HHbianban : dialog{label=\"画边板 黄明儒\";"<br />                 fn<br />     )<br />     (write-line        " :edit_box{label=\"边距 (mm)\";key=\"key1\";value=\"20\";}"<br />                 fn<br />     )<br />     (write-line        " :edit_box{label=\"角度(mm)\";key=\"key2\";value=\"15\";}"<br />                 fn<br />     )<br />     (write-line        " :edit_box{label=\"离端部 倍数\";key=\"key3\";value=\"1.5\";}"<br />                 fn<br />     )<br />     (write-line " ok_cancel;" fn)<br />     (write-line "  }" fn)<br />     (close fn)<br />   )<br /> <br />   (defun getdata (/ DCLDATA I KEY)<br />     (setq i 0)<br />     (repeat 3                                                    ;"key1"到"key5"<br />       (setq i (1+ i))<br />       (setq key (strcat "key" (itoa i)))<br />       (set (read key) (get_tile key))<br />       (setq DCLData (cons (cons key (eval (read key))) DCLData))<br />     )<br />     (Setenv "HHbianban" (VL-PRIN1-TO-STRING DCLData))<br />   )<br /> <br />   (defun setdata (/ DCLDATA X)<br />     (cond ((setq DCLData (getenv "HHbianban"))<br />            (setq DCLData (read DCLData))<br />            (mapcar '(lambda (x) (Set_tile (car x) (cdr x))) DCLData)<br />           )<br />     )<br />   )<br /> <br />    (defun do1 ()<br />     (ACET-UNDO-BEGIN)                                            ;编组<br />     (setq e0 (entlast))<br />     (if        (setq e (entsel "\n 型钢端线:"))<br />       (progn<br />         (setq p0 (cadr e))<br />         (setq obj (vlax-ename->vla-object (car e)))<br />         (setq key3 (* (distof key3) (vlax-get obj 'length)))<br />         (setq key3 (VL-PRINC-TO-STRING key3))<br />         (vl-cmdf "_offset" key3 e pause "")<br />       )<br />     )<br />     ;;如果偏移成功<br />     (setq e (entlast))<br />     (if        (not (equal e e0))<br />       (do2 e)<br />     )<br />     (ACET-UNDO-END)<br />   )<br /> <br /> <br />   ;;与PPCAD保持一致<br />   (if (not (tblsearch "layer" "4虚线层"))<br />     (vl-cmdf "_layer" "_M" "4虚线层" "_C" 6 "" "L" "DASHED" "" "")<br />   )<br /> <br />   (dialog)<br />   (setq dclid (load_dialog fname))<br />   (new_dialog "HHbianban" dclid)<br />   (setdata)<br />   (action_tile "accept" "(getdata)(done_dialog 1)")<br />   (action_tile "cancel" "(getdata)(done_dialog 0)")<br />   (setq return# (start_dialog))<br />   (unload_dialog dclid)<br />   (vl-file-delete fname)<br />   (cond ((equal return# 1) (do1)))<br /> )<br />

do2就交给你了

lzspain

运行时报错
当前图层:  0
输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P)/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)/外部参照(X)]: _M
输入新图层的名称 (成为当前图层) <0>: 4虚线层 输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P)/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)/外部参照(X)]: _C
新颜色 [真彩色(T)/配色系统(CO)] : 6
输入图层名列表，这些图层使用颜色 6 (洋红) <4虚线层>: 输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P)/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)/外部参照(X)]: L
输入已加载的线型名或 [?] <Continuous>: DASHED
输入使用线型“DASHED”的图层名列表 <4虚线层>: 输入选项 [?/生成(M)/设置(S)/新建(N)/重命名(R)/开(ON)/关(OFF)/颜色(C)/线型(L)/线宽(LW)/透明度(TR)/材质(MAT)/打印(P)/冻结(F)/解冻(T)/锁定(LO)/解锁(U)/状态(A)/说明(D)/协调(E)/外部参照(X)]:
命令: ; 错误: 参数太多

Qwer1243

自贡黄明儒 发表于 2024-9-24 10:14
机械行业同行呀，这个不错。以往我都是手画的。
选择角钢端部那条线，每边留20mm，以便于焊接，再沿角钢另 ...

我是钢结构深化的，经常会用到，两边的却是经常预留20mm，是不是规范我也不清楚

自贡黄明儒

机械行业同行呀，这个不错。以往我都是手画的。
选择角钢端部那条线，每边留20mm，以便于焊接，再沿角钢另一边移动一个距离（不知道这个距离有没有规范要求），这样更智能。

tiancao100

这不钢结构嘛， 必须15度吗? 不能自动剪裁

自贡黄明儒

tiancao100 发表于 2024-9-24 10:19
这不钢结构嘛， 必须15度吗? 不能自动剪裁

这个角度应该是个变值，可以取0度。关键楼主点取那条线，到角钢端部，有没有规范要求。

Qwer1243

tiancao100 发表于 2024-9-24 10:19
这不钢结构嘛， 必须15度吗? 不能自动剪裁

15度，可以在代码里面调整，一般都是15度，我就没添加调整参数

自贡黄明儒

Qwer1243 发表于 2024-9-24 10:28
15度，可以在代码里面调整，一般都是15度，我就没添加调整参数

弄个界面，适应各种情况

Qwer1243

我更新了一下代码，可以使用与水平和竖直线了@xyp1964

Qwer1243

自贡黄明儒 发表于 2024-9-24 11:23
弄个界面，适应各种情况

我不会做面板，你要是方便的话可以帮忙更新一下面板，我刚才重新上传了代码，水平和竖直线不会报错了