各显神通
本帖最后由 小鸟 于 2023-7-27 21:35 编辑
;论坛下载的程序 功能是生成图元的外框需要增加功能 让用户自己输入增加矩形偏移量加大或者缩小生成的框大小
;能不能帮我修改下新建一个矩形框图层把生成的矩形框放到新建的图层中去谢谢大佬
;;;;功能：最大矩形外框
;;;逆流而上的鱼制作
(defun c:多个矩形框 (/ entp1 p2obj k ss)
(vl-load-com)
(setvar "OSMODE" 0)
(setq ii (getdist "\n输入边框距离:"))
(if (setq ss (ssget))
(repeat (setq k (sslength ss))
(setq ent (ssname ss (setq k (1- k))))
(setq obj (vlax-ename->vla-object ent))
(vla-getboundingbox obj 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
)
(setq p1 (list (-(car p1) ii)(-(cadr p1) ii))
p2 (list (+(car p2) ii)(+(cadr p2) ii))
)
(vl-cmdf "rectang" p1 p2)
(if (= (tblsearch "layer" "矩形框图层") nil)
(command "layer" "m" "矩形框图层" "c" "1" "" "")
)
(command "_chprop" "l" "" "la" "矩形框图层" "");改图层
)
)
(princ)
)
(defun c:tt ()
"最大矩形外框"
(or dd (setq dd 100))
(setq dd (Udist 7 "" "偏移距离<输入或鼠标直接量取>" dd nil))
(if (setq ss (ssget))
(progn
(xyp-MkLaCo "1" 1)
(setq i -1)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq s1 (xyp-Rectang (xyp-9pt s1 1) (xyp-9pt s1 9))
s1 (xyp-Offset s1 dd t nil t)
)
)
)
)
(princ)
)
八仙过海呀。。。。
jun353835273 发表于 2023-7-27 18:49
大神的程序挺好用，能把画的矩形边长取整吗？四舍五入保证，如7.5,8,8.5……
paulpipi 发表于 2023-7-28 11:00
大神的程序挺好用，能把画的矩形边长取整吗？四舍五入保证，如7.5,8,8.5……
(atoi (rtos 8.4 2 0))=8
函数 你自己搞上去试一试
jun353835273 发表于 2023-7-28 12:46
(atoi (rtos 8.4 2 0))=8
函数 你自己搞上去试一试
谢谢大神回复，是可以取整，但矩形偏位不在正中，而且没有保留一位小数，麻烦指导一下，看怎么修改，感谢！
paulpipi 发表于 2023-7-28 14:06
谢谢大神回复，是可以取整，但矩形偏位不在正中，而且没有保留一位小数，麻烦指导一下，看怎么修改，感谢 ...
取整了怎么保留一位小数，还是只保留1位小数。
jun353835273 发表于 2023-7-28 15:20
取整了怎么保留一位小数，还是只保留1位小数。
就是0.5,1,1.5,2,2.5,3,3.5……就是小数点后面不是0.5就取0.5，如果超过0.5就取整，可能我表达的不清楚，不好意思
paulpipi 发表于 2023-7-28 16:37
就是0.5,1,1.5,2,2.5,3,3.5……就是小数点后面不是0.5就取0.5，如果超过0.5就取整，可能我表达的不清楚， ...
;;;;功能：最大矩形外框
;;20230728半途中修改
(defun c:att ( / ent p1 p2 obj k ss p11p22 dis)
(vl-load-com)
(setvar "OSMODE" 0)
(setq dis (getdist "\n输入边框距离:"))
(if (and dis
(setq dis (fixdata dis))
(setq ss (ssget )))
(repeat (setq k (sslength ss))
(setq ent (ssname ss (setq k (1- k))))
(setq obj (vlax-ename->vla-object ent))
(vla-getboundingbox obj 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
)
(setq p11 (mapcar '(lambda(x)(- x dis) )p1))
(setq p22 (mapcar '(lambda(x)(+ x dis) )p2))
(Make-Rectangep11 p22)
)
)
(princ)
)
;;;;20230728半途中修改
;;数据处理
(defun fixdata(in / out)
(setq out (atof (rtos in 2 0 ) ))
(if (> inout)
(setq out (+ (fix in) 0.5))
)
out
)
(defun Make-Rectange (pt1 pt2)
(entmake
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
(cons 8 "new-rectang")
(cons 62 1)
(cons 10 (list (car pt1) (cadr pt1)))
(cons 10 (list (car pt2) (cadr pt1)))
(cons 10 (list (car pt2) (cadr pt2)))
(cons 10 (list (car pt1) (cadr pt2)))
(cons 210 '(0 0 1))
)
)
)
试一试