lisp不能实现是么
能啊,麻烦而已 你有种再说一遍 发表于 2024-7-8 17:52
能啊,麻烦而已
有没有能用的 muai2010 发表于 2024-7-8 17:57
有没有能用的
论坛搜搜看看 看看这个能否满足你的要求
(defun gp:getobjbound (e_name / lo_dxf i
pt_list point-a oldx oldy
pt1 pt2 point-b tmp-app-name
boundpt lenx leny
)
(setq lo_dxf (entget e_name))
(setq i 0)
(setq pt_list nil)
(repeat (length lo_dxf)
(if (= (car (nth i lo_dxf)) 10)
(setq pt_list (append pt_list (list (nth i lo_dxf))))
)
(setq i (1+ i))
)
(setq is-rotate nil)
(if (= (length pt_list) 4)
(progn
(setq pt1 (cdr (nth 0 pt_list))
pt2 (cdr (nth 1 pt_list))
pt3 (cdr (nth 2 pt_list))
pt4 (cdr (nth 3 pt_list))
)
(if (or (and (= (/ (angle pt1 pt2) (/ pi 2))
(fix (/ (angle pt1 pt2) (/ pi 2)))
)
(= (/ (angle pt2 pt3) (/ pi 2))
(fix (/ (angle pt2 pt3) (/ pi 2)))
)
)
(and (= (/ (angle pt1 pt2) (/ pi 2))
(fix (/ (angle pt1 pt2) (/ pi 2)))
)
(= (/ (angle pt4 pt1) (/ pi 2))
(fix (/ (angle pt4 pt1) (/ pi 2)))
)
)
(and (= (/ (angle pt3 pt4) (/ pi 2))
(fix (/ (angle pt3 pt4) (/ pi 2)))
)
(= (/ (angle pt4 pt1) (/ pi 2))
(fix (/ (angle pt4 pt1) (/ pi 2)))
)
)
(and (= (/ (angle pt3 pt4) (/ pi 2))
(fix (/ (angle pt3 pt4) (/ pi 2)))
)
(= (/ (angle pt2 pt3) (/ pi 2))
(fix (/ (angle pt2 pt3) (/ pi 2)))
)
)
)
(progn
(setq tmp-app-name (vla-get-name (vlax-get-acad-object)))
(if (= tmp-app-name "AutoCAD");根据不同的CAD系统获取旋转后对象的最小包容角点坐标
(progn
(vla-getboundingbox ;取最小包容角点坐标
(vlax-ename->vla-object e_name)
'pt1
'pt2
)
(setq pt1 (vlax-safearray->list pt1)
pt1 (list (car pt1) (cadr pt1) 0)
pt2 (vlax-safearray->list pt2)
pt2 (list (car pt2) (cadr pt2) 0)
)
(setq boundpt (list pt1 pt2))
)
(setq boundpt (getboundingbox e_name)) ;取最小包容角点坐标
)
(setq LenX (abs (- (caar boundpt) (caadr boundpt))))
;计算最小包容矩形的X尺寸
(setq LenY (abs (- (cadar boundpt) (cadadr boundpt))))
(setq oldx lenx
oldy leny
)
)
(setq is-rotate t)
)
)
)
(if (or (/= (length pt_list) 4) is-rotate)
(progn
(setq i 1
point-a
(vlax-3d-point ;取第一顶点坐标
(list (cadr (nth 0 pt_list)) (caddr (nth 0 pt_list)))
)
oldX 0
oldy 0
)
(repeat (- (length pt_list) 1) ;以第一顶点为基点循环其它各顶点旋转到水平，取其最小面积为介料面积
(setq
point-b (vlax-3d-point ;取第i个顶点的坐标
(list (cadr (nth i pt_list))
(caddr (nth i pt_list))
)
)
i (1+ i) ;i递增1
)
(vlax-invoke-method
(vlax-ename->vla-object e_name)
'Rotate
point-a
(* -1
(angle (vlax-safearray->list (vlax-variant-value point-a))
(vlax-safearray->list (vlax-variant-value point-b))
)
)
) ;以点POINT-A为基点，将点POINT-A到POINT-B旋转成水平
(setq tmp-app-name (vla-get-name (vlax-get-acad-object)))
(if (= tmp-app-name "AutoCAD") ;根据不同的CAD系统获取旋转后对象的最小包容角点坐标
(progn
(vla-getboundingbox ;取最小包容角点坐标
(vlax-ename->vla-object e_name)
'pt1
'pt2
)
(setq pt1 (vlax-safearray->list pt1)
pt1 (list (car pt1) (cadr pt1) 0)
pt2 (vlax-safearray->list pt2)
pt2 (list (car pt2) (cadr pt2) 0)
)
(setq boundpt (list pt1 pt2))
)
(setq boundpt (getboundingbox e_name)) ;取最小包容角点坐标
)
;---------------------------------------------
(vlax-invoke-method
(vlax-ename->vla-object e_name)
'Rotate
point-a
(angle (vlax-safearray->list (vlax-variant-value point-a))
(vlax-safearray->list (vlax-variant-value point-b))
)
)
) ;恢复到原始状态
;----------------------------------------------------
(setq LenX (abs (- (caar boundpt) (caadr boundpt))))
;计算最小包容矩形的X尺寸
(setq LenY (abs (- (cadar boundpt) (cadadr boundpt))))
;计算最小包容矩形的Y尺寸
(if (and (/= oldx 0) (/= oldy 0))
(if (<= (* lenx leny) (* oldx oldy))
;比较最新获取的尺寸与上一个尺寸
(setq oldx lenx ;将较小尺寸进行保存
oldy leny
)
)
(setq oldx lenx
oldy leny
)
)
)
)
(list oldx oldy) ;返回比较后的最小尺寸给调用程序
) Saging 发表于 2024-7-10 15:06
看看这个能否满足你的要求
(defun gp:getobjbound (e_name / lo_dxf i
pt_list point-a ...
有示例么，函数没应用成功，暂没看到效果 Saging 发表于 2024-7-10 15:06
看看这个能否满足你的要求
(defun gp:getobjbound (e_name / lo_dxf i
pt_list point-a ...
(setq boundpt (getboundingbox e_name)) ;取最小包容角点坐标
大佬 缺getboundingbox 函数 自贡黄明儒 发表于 2024-7-29 10:31
http://bbs.xdcad.net/thread-703906-1-1.html
感谢黄大师，不过这个是求选集，还有圆弧和园不支持，哈哈，没有框选后单体的最小包围盒;P muai2010 发表于 2024-7-29 11:37
感谢黄大师，不过这个是求选集，还有圆弧和园不支持，哈哈，没有框选后单体的最小包围盒
没看到谁搞过。对于Text mtext attdef circle，完整椭圆，是可以直接求得最小面积包围盒的。这些得自己整理了。
页:
1
[2]