分享一个可以画斜线15°外廓线的代码
本帖最后由 Qwer1243 于 2024-9-25 09:45 编辑在放样水撑和柱撑详图的过程中可能会用到，有需要的可以看一下；有优化意见的欢迎分享
感谢黄明儒大师提供的界面函数和优化思路，下面代码已更新，增加了参数界面，水平线和竖直线也已适用(defun C:e7 (/ dialog getdata setdata do1 DCLID FN FNAME)
(defun dialog ()
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(write-line "HHbianban : dialog{label=\"连接板放样\";"
fn
)
(write-line " :edit_box{label=\"边距 (mm)\";key=\"key1\";value=\"20\";}"
fn
)
(write-line " :edit_box{label=\"角度(mm)\";key=\"key2\";value=\"15\";}"
fn
)
(write-line " :edit_box{label=\"距离端线长度\";key=\"key3\";value=\"100\";}"
fn
)
(write-line " ok_cancel;" fn)
(write-line "}" fn)
(close fn)
)
(defun getdata (/ DCLDATA I KEY)
(setq i 0)
(repeat 3 ;"key1"到"key5"
(setq i (1+ i))
(setq key (strcat "key" (itoa i)))
(set (read key) (get_tile key))
(setq DCLData (cons (cons key (eval (read key))) DCLData))
)
(Setenv "HHbianban" (VL-PRIN1-TO-STRING DCLData))
)
(defun setdata (/ DCLDATA X)
(cond ((setq DCLData (getenv "HHbianban"))
(setq DCLData (read DCLData))
(mapcar '(lambda (x) (Set_tile (car x) (cdr x))) DCLData)
)
)
)
(defun do1 (/ ang c data line m m_perp numb1 numb2 numb3 pt pt1 pt2 pt3 pt4 x x1 x2 y_proj y1 y2)
(setvar "cmdecho" 0)
(while (setq line (entsel "\n选择直线: "))
(setq pt (getpoint "\n请指定方向: "))
(setq data (entget (car line)))
(setq x1 (cadr (assoc 10 data)) x2 (cadr (assoc 11 data)) y1 (caddr (assoc 10 data)) y2 (caddr (assoc 11 data)))
;;读取面板数值
(setq numb1 (atof key1) numb2 (atof key2) numb3 (atof key3))
;;选择直线为水平线
(if (= y1 y2)
(progn
(princ "\n为水平线")
(setq ang (/ pi 2))
(if (< x1 x2)
(progn
(setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点
(setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)
)
(progn
(setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点
(setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)
)
)
(if (> (cadr pt) y1)
(progn
(princ "\n点在直线上方。")
(setq pt1 (polar pt1 (* pi (/ 270 180.0)) numb3)) ;远离端线
(setq pt2 (polar pt2 (* pi (/ 270 180.0)) numb3)) ;远离端线
(setq pt1 (polar pt1 (* pi (/ 180 180.0)) numb1)) ;边距
(setq pt2 (polar pt2 (* pi (/ 0 180.0)) numb1)) ;边距
(setq pt3 (polar pt1 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
(setq pt4 (polar pt2 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
)
(progn
(princ "\n点在直线下方。")
(setq pt1 (polar pt1 (* pi (/ 90 180.0)) numb3)) ;远离端线
(setq pt2 (polar pt2 (* pi (/ 90 180.0)) numb3)) ;远离端线
(setq pt1 (polar pt1 (* pi (/ 180 180.0)) numb1)) ;边距
(setq pt2 (polar pt2 (* pi (/ 0 180.0)) numb1)) ;边距
(setq pt3 (polar pt1 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
(setq pt4 (polar pt2 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
)
)
)
)
;;选择直线为竖直线
(if (= x1 x2)
(progn
(princ "\n为竖直线")
(setq ang 0)
(if (< y1 y2)
(progn
(setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点
(setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)
)
(progn
(setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点
(setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)
)
)
(if (> (car pt) x1)
(progn
(princ "\n点在直线右侧。")
(setq pt1 (polar pt1 (* pi (/ 180 180.0)) numb3)) ;远离端线
(setq pt2 (polar pt2 (* pi (/ 180 180.0)) numb3)) ;远离端线
(setq pt1 (polar pt1 (* pi (/ 270 180.0)) numb1)) ;边距
(setq pt2 (polar pt2 (* pi (/ 90 180.0)) numb1)) ;边距
(setq pt3 (polar pt1 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
(setq pt4 (polar pt2 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
)
(progn
(princ "\n点在直线左侧。")
(setq pt1 (polar pt1 (* pi (/ 0 180.0)) numb3)) ;远离端线
(setq pt2 (polar pt2 (* pi (/ 0 180.0)) numb3)) ;远离端线
(setq pt1 (polar pt1 (* pi (/ 270 180.0)) numb1)) ;边距
(setq pt2 (polar pt2 (* pi (/ 90 180.0)) numb1)) ;边距
(setq pt3 (polar pt1 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
(setq pt4 (polar pt2 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
)
)
)
)
;;选择直线为斜线
(if (and (/= x1 x2) (/= y1 y2))
(progn
(princ "\n为斜线")
(if (< y1 y2)
(progn
(setq pt1 (cdr (assoc 10 data))) ; 获取直线的第一个点
(setq pt2 (cdr (assoc 11 data))) ; 获取直线的第二个点)
)
(progn
(setq pt2 (cdr (assoc 10 data))) ; 获取直线的第一个点
(setq pt1 (cdr (assoc 11 data))) ; 获取直线的第二个点)
)
)
; 计算斜率 m 和截距 c
(setq m (/ (- (cadr pt2) (cadr pt1)) (- (car pt2) (car pt1))))
(setq c (- (cadr pt1) (* m (car pt1))))
; 计算垂直线的斜率
(setq m_perp (- (/ 1 m)))
; 计算角度
(setq ang (atan m_perp))
;计算点 P 到直线的垂直投影点的 y 坐标
(setq x (car pt))
(setq y_proj (+ (* m x) c))
;判断点的位置
(if (> ang 0)
(if (> (cadr pt) y_proj)
(progn
(princ "\n点在直线上方。")
(setq pt1 (polar pt1 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线
(setq pt2 (polar pt2 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线
(setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距
(setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距
(setq pt3 (polar pt1 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
(setq pt4 (polar pt2 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
)
(progn
(princ "\n点在直线下方。")
(setq pt1 (polar pt1 ang numb3)) ;远离端线
(setq pt2 (polar pt2 ang numb3)) ;远离端线
(setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距
(setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距
(setq pt3 (polar pt1 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
(setq pt4 (polar pt2 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
)
)
(if (> (cadr pt) y_proj)
(progn
(princ "\n点在直线上方。")
(setq pt1 (polar pt1 ang numb3)) ;远离端线
(setq pt2 (polar pt2 ang numb3)) ;远离端线
(setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距
(setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距
(setq pt3 (polar pt1 (+ ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
(setq pt4 (polar pt2 (- ang (* pi (/ (+ 180 numb2) 180.0))) 300)) ;numb2°斜线
)
(progn
(princ "\n点在直线下方。")
(setq pt1 (polar pt1 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线
(setq pt2 (polar pt2 (+ ang (* pi (/ 180 180.0))) numb3)) ;远离端线
(setq pt1 (polar pt1 (- ang (* pi (/ 90 180.0))) numb1)) ;边距
(setq pt2 (polar pt2 (+ ang (* pi (/ 90 180.0))) numb1)) ;边距
(setq pt3 (polar pt1 (- ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
(setq pt4 (polar pt2 (+ ang (* pi (/ numb2 180.0))) 300)) ;numb2°斜线
)
)
)
)
)
(entmakeX (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
(entmakeX (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt3)))
(entmakeX (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt4)))
(princ "\n~~~~~~~~~~~分割线~~~~~~~~~~~")
)
(princ return#)
)
(dialog)
(setq dclid (load_dialog fname))
(new_dialog "HHbianban" dclid)
(setdata)
(action_tile "accept" "(getdata)(done_dialog 1)")
(action_tile "cancel" "(getdata)(done_dialog 0)")
(setq return# (start_dialog))
(unload_dialog dclid)
(vl-file-delete fname)
(cond ((equal return# 1) (do1)))
)
本帖最后由 自贡黄明儒 于 2024-9-29 11:57 编辑
Qwer1243 发表于 2024-9-24 11:45
我不会做面板，你要是方便的话可以帮忙更新一下面板，我刚才重新上传了代码，水平和竖直线不会报错了
(defun C:Ban (/ dialog getdata setdata do1 DCLID FN FNAME)
(defun dialog ()
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(write-line "HHbianban : dialog{label=\"画边板 黄明儒\";"
fn
)
(write-line " :edit_box{label=\"边距 (mm)\";key=\"key1\";value=\"20\";}"
fn
)
(write-line " :edit_box{label=\"角度(mm)\";key=\"key2\";value=\"15\";}"
fn
)
(write-line " :edit_box{label=\"离端部 倍数\";key=\"key3\";value=\"1.5\";}"
fn
)
(write-line " ok_cancel;" fn)
(write-line "}" fn)
(close fn)
)
(defun getdata (/ DCLDATA I KEY)
(setq i 0)
(repeat 3 ;"key1"到"key5"
(setq i (1+ i))
(setq key (strcat "key" (itoa i)))
(set (read key) (get_tile key))
(setq DCLData (cons (cons key (eval (read key))) DCLData))
)
(Setenv "HHbianban" (VL-PRIN1-TO-STRING DCLData))
)
(defun setdata (/ DCLDATA X)
(cond ((setq DCLData (getenv "HHbianban"))
(setq DCLData (read DCLData))
(mapcar '(lambda (x) (Set_tile (car x) (cdr x))) DCLData)
)
)
)
(defun do1 ()
(ACET-UNDO-BEGIN) ;编组
(setq e0 (entlast))
(if (setq e (entsel "\n 型钢端线:"))
(progn
(setq p0 (cadr e))
(setq obj (vlax-ename->vla-object (car e)))
(setq key3 (* (distof key3) (vlax-get obj 'length)))
(setq key3 (VL-PRINC-TO-STRING key3))
(vl-cmdf "_offset" key3 e pause "")
)
)
;;如果偏移成功
(setq e (entlast))
(if (not (equal e e0))
(do2 e)
)
(ACET-UNDO-END)
)
;;与PPCAD保持一致
(if (not (tblsearch "layer" "4虚线层"))
(vl-cmdf "_layer" "_M" "4虚线层" "_C" 6 "" "L" "DASHED" "" "")
)
(dialog)
(setq dclid (load_dialog fname))
(new_dialog "HHbianban" dclid)
(setdata)
(action_tile "accept" "(getdata)(done_dialog 1)")
(action_tile "cancel" "(getdata)(done_dialog 0)")
(setq return# (start_dialog))
(unload_dialog dclid)
(vl-file-delete fname)
(cond ((equal return# 1) (do1)))
)
do2就交给你了 运行时报错
当前图层: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)]:
命令: ; 错误: 参数太多 自贡黄明儒 发表于 2024-9-24 10:14
机械行业同行呀，这个不错。以往我都是手画的。
选择角钢端部那条线，每边留20mm，以便于焊接，再沿角钢另 ...
我是钢结构深化的，经常会用到，两边的却是经常预留20mm，是不是规范我也不清楚 机械行业同行呀，这个不错。以往我都是手画的。
选择角钢端部那条线，每边留20mm，以便于焊接，再沿角钢另一边移动一个距离（不知道这个距离有没有规范要求），这样更智能。 这不钢结构嘛， 必须15度吗? 不能自动剪裁 tiancao100 发表于 2024-9-24 10:19
这不钢结构嘛， 必须15度吗? 不能自动剪裁
这个角度应该是个变值，可以取0度。关键楼主点取那条线，到角钢端部，有没有规范要求。 tiancao100 发表于 2024-9-24 10:19
这不钢结构嘛， 必须15度吗? 不能自动剪裁
15度，可以在代码里面调整，一般都是15度，我就没添加调整参数 本帖最后由 自贡黄明儒 于 2024-9-24 14:54 编辑
Qwer1243 发表于 2024-9-24 10:28
15度，可以在代码里面调整，一般都是15度，我就没添加调整参数
弄个界面，适应各种情况 我更新了一下代码，可以使用与水平和竖直线了@xyp1964 自贡黄明儒 发表于 2024-9-24 11:23
弄个界面，适应各种情况
我不会做面板，你要是方便的话可以帮忙更新一下面板，我刚才重新上传了代码，水平和竖直线不会报错了