软件
产品
在使用AutoCAD绘制船舶图纸的时候，部分绘制过程重复且繁琐。因此，借助AutoCAD本身强大的插件功能，或许可以为图纸的绘制带来些许便捷。
本文将分享一个新鲜出炉的插件，功能为：简单三角肘板的快速绘制。完全按照我个人平时的绘图偏好设计的。如果不符合您的偏好，发给ds去改就好了。
本插件历经82+4轮与ds以及13+6轮与gpt的深刻对话，目前终于可以在多数情况下使用了。后面或许还会有细节上的修改，再说吧，先勉强用着。
代码在下面，复制到记事本里，保存成.lsp格式，就可以放在AutoCAD的插件库里使用了，建议使用2025及之后的CAD版本，因为我只在25和26版CAD里试过。
插件的绘制效果如下图：
代码块
PlainText
自动换行
复制代码
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386
;;; 船舶肘板绘制 Bracket / BT
(defun c:Bracket (/ *error* bt:getdist bt:getpointonline
bt:point-in-sector bt:get-nearest-int
bt:perpendicular-toward bt:intersect-circle-xline
bt:clip-line-to-corner bt:clip-arc-to-corner
bt:draw-minor-arc bt:makebracket
oldOsnap toeLen type V curve1 P1 curve2 P2
lenA lenB arcR doDash)
(defun *error* (msg)
(if oldOsnap (setvar 'osmode oldOsnap))
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ (strcat "\n错误: " msg)))
(princ))
(defun bt:getdist (prompt sysvar default / val)
(setq val (getvar sysvar))
(if (zerop val) (setq val default))
(setq val (cond ((getdist (strcat prompt " <" (rtos val 2 2) ">: "))) (val)))
(setvar sysvar val)
val)
(defun bt:getpointonline (msg / pt ss curve)
(setvar 'osmode 512)
(setq pt (getpoint msg))
(setvar 'osmode oldOsnap)
(if pt
(progn
(if (setq ss (ssget pt '((0 . "LINE,ARC,LWPOLYLINE,POLYLINE,SPLINE"))))
(progn
(setq curve (vlax-ename->vla-object (ssname ss 0)))
(setq pt (vlax-curve-getClosestPointTo curve pt))
(list curve pt))
(progn (princ "\n未找到有效曲线，请确保点在线上。") nil)))
nil))
;; 扇形区域判断（叉积法）
(defun bt:point-in-sector (pt V dir1 dir2 / v c1 c2 ref)
(setq v (mapcar '- pt V))
(setq c1 (- (* (car dir1) (cadr v)) (* (cadr dir1) (car v))))
(setq c2 (- (* (car v) (cadr dir2)) (* (cadr v) (car dir2))))
(setq ref (- (* (car dir1) (cadr dir2)) (* (cadr dir1) (car dir2))))
(if (>= ref 0)
(and (>= c1 -1e-8) (>= c2 -1e-8))
(and (<= c1 1e-8) (<= c2 1e-8))))
;;; ========== 核心修改 ==========
(defun bt:get-nearest-int (curve len V testpt dir1 dir2 / doc ms circle interpts
ptlist candidates bestpt bestParam paramTest d)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
ms (vla-get-ModelSpace doc)
circle (vla-AddCircle ms (vlax-3d-point V) len)
interpts (vlax-variant-value
(vla-IntersectWith circle curve acExtendNone)))
(vla-Delete circle)
(if (not (minusp (vlax-safearray-get-u-bound interpts 1)))
(progn
(setq ptlist (vlax-safearray->list interpts)
candidates nil)
(while ptlist
(setq pt (list (car ptlist)
(cadr ptlist)
(caddr ptlist))
ptlist (cdddr ptlist))
(setq candidates (cons pt candidates))
)
(if candidates
(progn
(setq paramTest
(vlax-curve-getParamAtPoint
curve
(vlax-curve-getClosestPointTo curve testpt)
)
)
(setq bestpt (car candidates)
bestParam
(abs
(- (vlax-curve-getParamAtPoint curve bestpt)
paramTest)))
(foreach pt (cdr candidates)
(setq d
(abs
(- (vlax-curve-getParamAtPoint curve pt)
paramTest)))
(if (< d bestParam)
(setq bestpt pt
bestParam d))
)
bestpt
)
(progn
(princ "\n未找到有效交点。")
nil
)
)
)
(progn
(princ "\n边长与曲线无交点。")
nil
)
)
)
(defun bt:perpendicular-toward (pt curve targetpt / tangent perp1 perp2 target)
(setq tangent (vlax-curve-getFirstDeriv curve (vlax-curve-getParamAtPoint curve pt)))
(if (equal tangent '(0.0 0.0 0.0) 1e-8)
(setq tangent (vlax-curve-getFirstDeriv curve (vlax-curve-getParamAtPoint curve (vlax-curve-getClosestPointTo curve pt)))))
(setq perp1 (list (- (cadr tangent)) (car tangent) 0.0)
perp2 (mapcar '- perp1))
(if (equal perp1 '(0.0 0.0 0.0) 1e-8)
(setq perp1 '(1.0 0.0 0.0) perp2 '(-1.0 0.0 0.0)))
(setq perp1 (mapcar '(lambda (x) (/ x (distance '(0 0 0) perp1))) perp1)
perp2 (mapcar '(lambda (x) (/ x (distance '(0 0 0) perp2))) perp2))
(setq target (mapcar '- targetpt pt))
(if (equal target '(0.0 0.0 0.0) 1e-8)
(setq target (mapcar '- V pt)))
(if (> (apply '+ (mapcar '* perp1 target)) 0) perp1 perp2))
(defun bt:intersect-circle-xline (V R dir1 dir2 / doc ms circle xl1 xl2 ints ptlist)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
ms (vla-get-ModelSpace doc))
(setq circle (vla-AddCircle ms (vlax-3d-point V) R))
(setq xl1 (vla-AddXline ms (vlax-3d-point V) (vlax-3d-point (mapcar '+ V dir1))))
(setq xl2 (vla-AddXline ms (vlax-3d-point V) (vlax-3d-point (mapcar '+ V dir2))))
(setq ints nil)
(foreach xl (list xl1 xl2)
(setq intpts (vlax-variant-value (vla-IntersectWith circle xl acExtendNone)))
(if (not (minusp (vlax-safearray-get-u-bound intpts 1)))
(progn
(setq ptlist (vlax-safearray->list intpts))
(while ptlist
(setq pt (list (car ptlist) (cadr ptlist) 0.0))
(setq ptlist (cdddr ptlist))
(if (bt:point-in-sector pt V dir1 dir2)
(setq ints (cons pt ints)))))))
(vla-Delete circle) (vla-Delete xl1) (vla-Delete xl2)
ints)
(defun bt:clip-line-to-corner (p1 p2 V dir1 dir2 / intersect-ray in1 in2 pts int)
(defun intersect-ray (p1 p2 dir)
(setq dx (- (car p2) (car p1)) dy (- (cadr p2) (cadr p1)))
(if (or (not (equal dx 0.0 1e-8)) (not (equal dy 0.0 1e-8)))
(progn
(setq denom (- (* (car dir) dy) (* (cadr dir) dx)))
(if (not (equal denom 0.0 1e-8))
(progn
(setq t (/ (- (* (cadr dir) (- (car p1) (car V))) (* (car dir) (- (cadr p1) (cadr V)))) denom))
(if (and (>= t -1e-8) (<= t (+ 1 1e-8)))
(list (mapcar '+ p1 (mapcar '(lambda (x) (* x t)) (list dx dy 0.0))) t)
nil))
nil))
nil))
(setq in1 (bt:point-in-sector p1 V dir1 dir2)
in2 (bt:point-in-sector p2 V dir1 dir2))
(if (and in1 in2) (list p1 p2)
(progn
(setq pts nil)
(if in1 (setq pts (cons (list p1 0.0) pts)))
(if in2 (setq pts (cons (list p2 1.0) pts)))
(foreach dir (list dir1 dir2)
(setq int (intersect-ray p1 p2 dir))
(if int (setq pts (cons int pts))))
(setq pts (vl-sort pts '(lambda (a b) (< (cadr a) (cadr b)))))
(if (>= (length pts) 2)
(list (car (car pts)) (car (last pts)))
(list p1 p2)))))
(defun bt:clip-arc-to-corner (center radius startAng endAng V dir1 dir2 / arc-intersect-xline angs midAng)
(defun arc-intersect-xline (cen rad sAng eAng dir)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
ms (vla-get-ModelSpace doc))
(setq arc (vla-AddArc ms (vlax-3d-point cen) rad sAng eAng))
(setq xl (vla-AddXline ms (vlax-3d-point V) (vlax-3d-point (mapcar '+ V dir))))
(setq intpts (vlax-variant-value (vla-IntersectWith arc xl acExtendNone)))
(setq res nil)
(if (not (minusp (vlax-safearray-get-u-bound intpts 1)))
(progn
(setq ptlist (vlax-safearray->list intpts))
(while ptlist
(setq pt (list (car ptlist) (cadr ptlist) (caddr ptlist))
ptlist (cdddr ptlist))
(if (bt:point-in-sector pt V dir1 dir2)
(setq res (cons (angle cen pt) res))))))
(vla-Delete arc) (vla-Delete xl)
res)
(setq angs (list startAng endAng))
(foreach dir (list dir1 dir2)
(setq intAng (arc-intersect-xline center radius startAng endAng dir))
(if intAng (setq angs (append angs intAng))))
(setq angs (mapcar '(lambda (x) (rem (+ x (* 2 pi)) (* 2 pi))) angs))
(setq angs (vl-sort angs '<))
(if (>= (length angs) 2)
(progn
(setq midAng (/ (+ (car angs) (last angs)) 2.0)
midPt (polar center midAng radius))
(if (bt:point-in-sector midPt V dir1 dir2)
(list center radius (car angs) (last angs))
(list center radius (last angs) (+ (car angs) (* 2 pi)))))
(list center radius startAng endAng)))
(defun bt:draw-minor-arc (center p1 p2 / ang1 ang2 sweep os)
(setq os (getvar 'osmode))
(setvar 'osmode 0)
(setq center (list (car center) (cadr center) 0.0)
p1 (list (car p1) (cadr p1) 0.0)
p2 (list (car p2) (cadr p2) 0.0))
(if (and (> (distance center p1) 1e-6) (> (distance center p2) 1e-6))
(progn
(setq ang1 (angle center p1) ang2 (angle center p2))
(if (> ang1 ang2) (setq ang1 (- ang1 (* 2 pi))))
(setq sweep (- ang2 ang1))
(if (> (abs sweep) pi)
(command "_.arc" p1 p2 center)
(command "_.arc" "c" center p1 p2))
(setvar 'osmode os)
(entlast))
(progn (setvar 'osmode os) nil)))
(defun bt:makebracket (V P1 P2 curve1 curve2 lenA lenB arcRadius doDash toeLength /
T1 T2 dir1 dir2 E1 E2 perp1 perp2
freeLine pts ints p1Int p2Int mid dir dashEnt
freeVec perpVec os)
(setq os (getvar 'osmode))
(setvar 'osmode 0)
(setq dir1 (mapcar '- P1 V) dir2 (mapcar '- P2 V))
(setq T1 (bt:get-nearest-int curve1 lenA V P1 dir1 dir2))
(setq T2 (bt:get-nearest-int curve2 lenB V P2 dir1 dir2))
(if T1
(setq T1
(vlax-curve-getClosestPointTo
curve1 T1)))
(if T2
(setq T2
(vlax-curve-getClosestPointTo
curve2 T2)))
(if (or (not T1) (not T2)) (progn (setvar 'osmode os) (exit)))
(setq perp1 (bt:perpendicular-toward T1 curve1 P2))
(setq E1 (mapcar '+ T1 (mapcar '(lambda (x) (* x toeLength)) perp1)))
(setq perp2 (bt:perpendicular-toward T2 curve2 P1))
(setq E2 (mapcar '+ T2 (mapcar '(lambda (x) (* x toeLength)) perp2)))
(setq E1 (list (car E1) (cadr E1) 0.0) E2 (list (car E2) (cadr E2) 0.0))
;; 趾端线
(foreach pair (list (list T1 E1) (list T2 E2))
(setq pts (bt:clip-line-to-corner (car pair) (cadr pair) V dir1 dir2))
(if (and (car pts) (cadr pts) (> (distance (car pts) (cadr pts)) 1e-6))
(command "_.line" (car pts) (cadr pts) "")))
;; 自由边
(if arcRadius
(progn
(setq chord (distance E1 E2)
halfchord (/ chord 2.0)
mid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) E1 E2)
vec (mapcar '- E2 E1)
h (sqrt (- (* arcRadius arcRadius) (* halfchord halfchord)))
dir (list (- (cadr vec)) (car vec) 0.0)
dirNorm (distance '(0 0 0) dir))
(setq center1 (mapcar '+ mid (mapcar '(lambda (x) (* x (/ h dirNorm))) dir))
center2 (mapcar '- mid (mapcar '(lambda (x) (* x (/ h dirNorm))) dir)))
(if (< (distance V center1) (distance V center2))
(setq center center2) (setq center center1))
(setq sAng (angle center E1) eAng (angle center E2))
(setq arcDef (bt:clip-arc-to-corner center arcRadius sAng eAng V dir1 dir2))
(if arcDef
(progn
(setq center (car arcDef) arcRadius (cadr arcDef) sAng (caddr arcDef) eAng (cadddr arcDef))
(command "_.arc" "c" center (polar center sAng arcRadius) (polar center eAng arcRadius)))))
(progn
(setq pts (bt:clip-line-to-corner E1 E2 V dir1 dir2))
(if (and (car pts) (cadr pts) (> (distance (car pts) (cadr pts)) 1e-6))
(command "_.line" (car pts) (cadr pts) ""))))
(setq freeLine (entlast))
;; 通焊孔
(setq maxlen (max lenA lenB))
(cond ((<= maxlen 150) (setq holeR 25.0))
((<= maxlen 350) (setq holeR 35.0))
(t (setq holeR 50.0)))
(setq ints (bt:intersect-circle-xline V holeR dir1 dir2))
(if (and ints (>= (length ints) 2))
(progn
(setq ints (vl-sort ints (function (lambda (a b) (< (angle V a) (angle V b))))))
(setq p1Int (car ints) p2Int (last ints))
(setq midAng (/ (+ (angle V p1Int) (angle V p2Int)) 2.0)
midPt (polar V midAng holeR))
(if (not (bt:point-in-sector midPt V dir1 dir2))
(setq p1Int (last ints) p2Int (car ints)))
(bt:draw-minor-arc V p1Int p2Int))
(princ "\n通焊孔无交点？"))
;; 折边虚线
(if (and (not arcRadius) doDash freeLine)
(progn
(setq entdata (entget freeLine)
E1U (cdr (assoc 10 entdata))
E2U (cdr (assoc 11 entdata))
mid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) E1U E2U))
(if (and E1U E2U (> (distance E1U E2U) 1e-6))
(progn
(setq freeVec (mapcar '- E2U E1U))
(setq perpVec (list (- (cadr freeVec)) (car freeVec) 0.0))
(if (equal perpVec '(0.0 0.0 0.0) 1e-8) (setq perpVec '(1.0 0.0 0.0)))
(setq perpVec (mapcar '(lambda (x) (/ x (distance '(0 0 0) perpVec))) perpVec))
(if (< (apply '+ (mapcar '* perpVec (mapcar '- V mid))) 0.0)
(setq perpVec (mapcar '- perpVec)))
(command "_.offset" toeLength freeLine (mapcar '+ mid (mapcar '(lambda (x) (* x toeLength)) perpVec)) "")
(setq dashEnt (entlast))
(if (and dashEnt (not (equal dashEnt freeLine)))
(command "_.change" dashEnt "" "p" "lt" "DASHED" "ltScale" 10 "")
(princ "\n虚线偏移失败。"))
)
)
)
)
(setvar 'osmode os)
)
;; ========== 主程序 ==========
(setq oldOsnap (getvar 'osmode))
(setq toeLen (if (zerop (getvar 'userr4)) 20 (getvar 'userr4)))
(while (not type)
(princ (strcat "\n当前趾端长度=" (rtos toeLen 2 2)))
(initget "S R D")
(setq type (getkword "\n选择肘板类型 [标准三角形(S)/圆弧过渡(R)/趾端(D)] <S>: "))
(if (not type) (setq type "S"))
(if (eq type "D")
(progn
(setq toeLen (getdist "\n输入新趾端长度: "))
(setvar 'userr4 toeLen)
(setq type nil))))
(setvar 'osmode 32)
(setq V (getpoint "\n拾取肘板顶点（交点捕捉）: "))
(setvar 'osmode oldOsnap)
(if (not V) (progn (princ "\n未拾取到点，程序退出。") (exit)))
(setq V (osnap V "_int"))
(if (not V) (progn (princ "\n未捕捉到交点，程序退出。") (exit)))
(while (not curve1)
(setq res1 (bt:getpointonline "\n拾取第一条非自由边上的点（最近点捕捉）: "))
(if res1 (setq curve1 (car res1) P1 (cadr res1))
(princ "\n拾取点不在有效曲线上，请重试。")))
(while (not curve2)
(setq res2 (bt:getpointonline "\n拾取第二条非自由边上的点（最近点捕捉）: "))
(if res2 (setq curve2 (car res2) P2 (cadr res2))
(princ "\n拾取点不在有效曲线上，请重试。")))
(setq lenA (bt:getdist "第一条边长" 'userr1 150))
(setq lenB (bt:getdist "第二条边长" 'userr2 150))
(setq arcR nil doDash nil)
(if (eq type "R")
(setq arcR (bt:getdist "输入圆弧半径" 'userr3 200))
(progn
(initget "Y N")
(setq dashopt (getkword "\n是否添加折边虚线？[是(Y)/否(N)] <N>: "))
(if (eq dashopt "Y") (setq doDash t))))
(bt:makebracket V P1 P2 curve1 curve2 lenA lenB arcR doDash toeLen)
(setvar 'osmode oldOsnap)
(princ "\n肘板绘制完成。")
(princ))
(defun c:BT () (c:Bracket))
(princ "\n命令 Bracket / BT 肘板快速绘制插件已加载。")
(princ)
复制成功
好了没了就这么多，希望该插件可以稍微为您减轻一点点的工作负担，从而把更多的时间留给个人的闲暇。请相信，您闲暇的时间永远比无穷尽的工作更为宝贵。
如果本文对您有帮助的话，请给up一个免费的三连，谢谢tks~
免责声明：本文系网络转载或改编，未找到原创作者，版权归原作者所有。如涉及版权，请联系删
技术文档
推荐好文
155-2731-8020
