求一个画中心矩形的代码
本人对代码小白，求一个画中心矩形的代码，不胜感激本帖最后由 尘缘一生 于 2025-2-19 09:14 编辑
尽量少用COMMAND,下面是SLdesign V3.0 三领设计的代码...
;;entmake 多义线，带宽度，开关闭合-----(一级)------
;lst 点表 , plwid 线宽=num，dxf70 是否闭合= t 闭合,
(defun makelwpolyline (lst plwid dxf70 / pt)
(entmake
(append
(list
(cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline")
(cons 90 (length lst))
(if dxf70
(cons 70 1)
(cons 70 0)
)
(if plwid
(cons 43 plwid)
(cons 43 0)
)
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
)
)
;点表生成多段线--------(一级)-------
;线宽=nil，线宽为0;是否闭合=nil，不闭合 ;图层=nil，为当前图层 ;颜色=nil，为当前图层颜色;线型比例=nil，为1
;(slch:lwpolyline 点表 是否闭合 线宽 图层 颜色 线型比例)
;(slch:lwpolyline (list (1 2) (2 3)) t 2 "中心线" 6 5)
(defun slch:lwpolyline (lst dxf70 plwid lay lwplcol lwplbili / pt)
(entmake
(append
(list
(cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline")
(cons 90 (length lst)) ;点表
(if dxf70
(cons 70 1) ;闭合与不闭合
(cons 70 0)
)
(if plwid
(cons 43 plwid) ;线宽
(cons 43 0)
)
(if lay
(cons 8 lay) ;图层
(cons 8 (getvar "CLAYER"))
)
(if lay
(cons 6 (vla-get-linetype (vla-item *LAYS* lay)))
(cons 6 "CONTINUOUS")
)
(if lwplcol
(cons 62 lwplcol) ;颜色
(cons 62 256)
)
(if lwplbili
(cons 48 lwplbili) ;线型比例
(cons 48 (* 0.01 (getvar "DIMLFAC")))
)
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
)
)
;;画0矩形框-----------
(defun c:kua00 (/ p1 p2)
(setq p1 (getpoint (slmsg "\n 第一角点:" "\n 材à翴:" "\n First corner:")) p2 (getcorner p1 (slmsg "\n 第二角点:" "\n 材à翴:" "\n Second corner:")))
(makelwpolyline (list p1 (list (car p1) (cadr p2)) p2 (list (car p2) (cadr p1))) 0 t)
(princ)
)
;;画0.45框---------
(defun c:gjk (/ p1 p2)
(setq p1 (getpoint (slmsg "\n 第一角点:" "\n 材à翴:" "\n First corner:")) p2 (getcorner p1 (slmsg "\n 第二角点:" "\n 材à翴:" "\n Other corner:")))
(slch:lwpolyline (list p1 (list (car p1) (cadr p2)) p2 (list (car p2) (cadr p1))) t (* SLBL 0.45) (slmsg "钢筋" "葵惮" "steelbar") 1 nil)
)
(defun c:NM (/ center h pt1 pt2 pt3 pt4 w)
(setq w (getreal "\n请输入矩形的宽度: "))
(if (not w)
(progn
(princ "\n未输入宽度，命令取消。")
(exit)
)
)
(setq h (getreal "\n请输入矩形的高度: "))
(if (not h)
(progn
(princ "\n未输入高度，命令取消。")
(exit)
)
)
(setq center (cadr(grread 3)) )
(setq pt1 (list (- (car center) (/ w 2)) (+ (cadr center) (/ h 2))))
(setq pt2 (list (+ (car center) (/ w 2)) (+ (cadr center) (/ h 2))))
(setq pt3 (list (+ (car center) (/ w 2)) (- (cadr center) (/ h 2))))
(setq pt4 (list (- (car center) (/ w 2)) (- (cadr center) (/ h 2))))
(command "_.pline" pt1 pt2 pt3 pt4 pt1 "")
(command "_.move" (entlast) "" center pause)
(princ)
)
(defun c:tt ( / cen w h p1 p2 p3 p4)
; 获取宽度和高度
(setq w (getdist "\n输入矩形宽度: "))
(setq h (getdist "\n输入矩形高度: "))
; 获取中心点
(setq cen (getpoint "\n指定矩形中心点: "))
; 计算四个角点坐标
(setq p1 (list (- (car cen) (/ w 2)) (+ (cadr cen) (/ h 2)))) ; 左上角
(setq p2 (list (+ (car cen) (/ w 2)) (+ (cadr cen) (/ h 2)))) ; 右上角
(setq p3 (list (+ (car cen) (/ w 2)) (- (cadr cen) (/ h 2)))) ; 右下角
(setq p4 (list (- (car cen) (/ w 2)) (- (cadr cen) (/ h 2)))) ; 左下角
(setvar "OSMODE" 0);关闭捕捉
; 绘制闭合多段线
(command "_.pline" p1 p2 p3 p4 "_c")
(setvar"osmode"15359);恢复捕捉
(princ)
) 尘缘一生 发表于 2025-2-19 09:12
尽量少用COMMAND,下面是SLdesign V3.0 三领设计的代码...
这么长啊，函数还不齐:lol lailaifa 发表于 2025-2-19 09:22
这么长啊，函数还不齐
[*];;画0矩形框-----------
[*](defun c:kua00 (/ p1 p2)
[*](setq p1 (getpoint "\n 第一角点:") p2 (getcorner p1"\n 第二角点:"))
[*](makelwpolyline (list p1 (list (car p1) (cadr p2)) p2 (list (car p2) (cadr p1))) 0 t)
[*](princ)
[*])
[*];;画0.45框---------
[*](defun c:gjk (/ p1 p2)
[*](setq p1 (getpoint ) p2 (getcorner p1 "\n 第二角点:"))
[*](slch:lwpolyline (list p1 (list (car p1) (cadr p2)) p2 (list (car p2) (cadr p1))) t (* SLBL 0.45) "钢筋" 1 nil)
[*])
函数并非独为此，属于内裤部分。
SLBL 是三领设计的比例常量，"钢筋" 是图层
lailaifa 发表于 2025-2-19 08:19
(defun c:tt ( / cen w h p1 p2 p3 p4)
; 获取宽度和高度
(setq w (getdist "\n输入矩形宽度: "))
...
非常感谢谢大师的代码，明经有你更精彩 xj6019 发表于 2025-2-19 08:18
(defun c:NM (/ center h pt1 pt2 pt3 pt4 w)
(setq w (getreal "\n请输入矩形的宽度: "))
(if (not w) ...
非常感谢谢大师的代码，明经有你更精彩 尘缘一生 发表于 2025-2-19 09:46
[*];;画0矩形框-----------
[*](defun c:kua00 (/ p1 p2)
[*](setq p1 (getpoint "\n 第一角点:")...
非常感谢谢大师的代码，明经有你更精彩 感谢分享，收藏备用
页:
[1]
2