大佬帮我修改下程序
本帖最后由 787116960 于 2023-7-27 13:46 编辑论坛下载的程序 功能是生成图元的外框需要增加功能 让用户自己输入增加矩形偏移量加大或者缩小生成的框大小
能不能帮我修改下新建一个矩形框图层把生成的矩形框放到新建的图层中去谢谢大佬
;;;;功能：最大矩形外框
;;;逆流而上的鱼制作
(defun c:多个矩形框 ( / ent p1 p2 obj k ss)
(vl-load-com)
(setvar "OSMODE" 0)
(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)
)
(vl-cmdf "rectang" p1 p2)
)
)
(princ)
)
paulpipi 发表于 2023-7-30 11:40
谢谢大神耐心回复，但测试后发现数据没有改变，小数点后面还是多位小数，有空帮忙看一下，感谢！！
调试下 应该不会 试试这个效果：
;;;;功能：最大矩形外框
;;;逆流而上的鱼制作
(defun c:多个矩形框 ( / ent p1 p2 obj k ss p11p22 dis)
(vl-load-com)
(setvar "OSMODE" 0)
(setq dis (getdist "\n输入边框距离:"))
(if (and 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))
(vl-cmdf "rectang" p11 p22)
)
)
(princ)
)
jun353835273 发表于 2023-7-27 12:59
大佬 能不能帮我修改下新建一个矩形框图层把生成的矩形框放到新建的图层中去谢谢大佬 ssyfeng 发表于 2023-7-27 14:56
试试这个效果：
老哥我没有名金币 给论坛做点贡献，买些就好了，太容易得到的东西都不太珍惜。 不错，能分堆在画框最好了 787116960 发表于 2023-7-27 13:45
大佬 能不能帮我修改下新建一个矩形框图层把生成的矩形框放到新建的图层中去谢谢大佬
;;;;功能：最大矩形外框
;;;逆流而上的鱼制作
(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 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)
)
(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))
)
)
)
787116960 发表于 2023-7-27 14:59
老哥我没有名金币
(defun c:tt ()
"最大矩形外框"
(if (setq ss (ssget))
(progn
(setq os (getvar 'osmode)
la (getvar 'clayer)
)
(setq i -1)
(setvar "OSMODE" 0)
(command "-layer" "m" "1" "c" "1" "" "")
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq ob (vlax-ename->vla-object s1))
(vla-getboundingbox ob 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
p2 (vlax-safearray->list p2)
)
(vl-cmdf "rectang" p1 p2)
)
(setvar 'osmode os)
(setvar 'clayer la)
)
)
(princ)
) 再来一个，这样也可以的，直接偏移
(defun c:att2 ( / doc lay ent p1 p2 obj k ss p11p22 dis)
(vl-load-com)
(if (not (tblsearch "layer" "new"))
(progn
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq lay (Vla-Add (Vlax-Get doc 'Layers) "new" ))
)
)
(setvar "OSMODE" 0)
(setq dis (getdist "\n输入边框距离:"))
(if (and dis
(setq ss (ssget )))
(repeat (setq k (sslength ss))
(setq ent (ssname ss (setq k (1- k))))
(setq obj (vlax-ename->vla-object ent))
(setq obj2 (vla-offset obj (- 0 dis)))
(Vla-Put-Layer (CAR (vlax-safearray->list (vlax-variant-value obj2)))"new" )
)
)
(princ)
)