请教一下,自动图层和最大块包围框lisp冲突，谁能帮看看
2个程序都是从论坛下载的，发现他们同时启动加载就会冲突，使用最大块包围框的程序时，就会弹出如下对话框；并且CAD就一直弹框报错，关都要强行关掉。
我还发现这个包围框的程序和【Gu_xl】版主的自动切换图层也会冲突，估计是这个包围框程序的问题？
有大神能帮忙改一下吗，让他们可以兼容使用，本人不会写程序，只是想找一些程序来提高工作效率，谢谢大家~
以下是自动图层
(defun xlr-autolayer ()
;; 图层初始化列表 内容：commands layers color linetype plottable
(setq *doc (vla-get-activedocument (vlax-get-acad-object)))
(setq *lays (vla-get-layers *doc))
(setq*laylst
(list (list "DIMANGULAR" "DIM" 3 "continuous" T)
(list "DIMALIGNED" "DIM" 3 "continuous" T)
(list "DIMBASELINE" "DIM" 3 "continuous" T)
(list "DIMCENTER" "DIM" 3 "continuous" T)
(list "DIMCONTINUE" "DIM" 3 "continuous" T)
(list "DIMDIAMETER" "DIM" 3 "continuous" T)
(list "DIMLINEAR" "DIM" 3 "continuous" T)
(list "DIMORDINATE" "DIM" 3 "continuous" T)
(list "DIMRADIUS" "DIM" 3 "continuous" T)
(list "QDIM" "DIM" 3 "continuous" T)
(list "QLEADER" "DIM" 3 "continuous" T)
(list "DTEXT" "TXT" 3 "continuous" T)
(list "MTEXT" "TXT" 3 "continuous" T)
(list "TEXT" "TXT" 3 "continuous" T)
;(list "BHATCH" "填充" 9 "continuous" T)
;(list "HATCH" "填充" 9 "continuous" T)
;(list "POINT" "点" 4 "continuous" T)
;(list "XLINE" "辅助线" 8 "continuous" T)
;(list "LINE" "0" NIL "continuous" T)
;(list "XREF" "引用" 7 "continuous" T)
;(list "pline" "多义线" 2 "center" T)
)
)
(setq OldLayer nil)
(setq *cmdlst (mapcar 'strcase (mapcar 'car *laylst)))
(mapcar '(lambda (x) (vlr-command-reactor nil x))
(list'((:vlr-commandWillStart . xlr-start))
'((:vlr-commandEnded . xlr-end))
'((:vlr-commandCancelled . xlr-cancel))
)
)
(vlr-editor-reactor nil '((:vlr-commandwillstart . xlr-edit)))
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-edit(call callback / n)
(foreach n *laylst
(if(= (strcase (car callback)) (strcase (car n)))
(apply 'xsetlays (cdr n))
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-start (calling-reactor xlr-startinfo / n)
(foreach n *laylst
(if (= (strcase (car xlr-startinfo)) (strcase (car n)))
(apply 'xsetlays (cdr n))
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-end (calling-reactor xlr-endinfo / cmd)
(setq cmd (car xlr-endinfo))
(if (member cmd *cmdlst)
(if (/= oldlayer nil)
(progn
(setvar "clayer" oldlayer)
(setq oldlayer nil)
)
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-cancel (calling-reactor xlr-cancelinfo / cmd)
(setq cmd (car xlr-cancelinfo))
(if (member cmd *cmdlst)
(if (/= oldlayer nil)
(progn
(setvar "clayer" oldlayer)
(setq oldlayer nil)
)
)
)
)
;;;----------------------------------------------------------------------------;;;
;;;----------------------------------------------------------------------------;;;
(defun xsetlays(lay-nam color ltype plotk / layobj ltypesobj)
(defun layeron (layername / layerdata)
(setq layerdata (entget (tblobjname "LAYER" layername)))
(if (< (cdr (assoc 62 layerdata)) 0)
(progn
(setq layerdata (subst
(cons 62 (- 0 (cdr (assoc 62 layerdata))))
(assoc 62 layerdata)
layerdata
)
)
(entmod layerdata)
)
)
)
(if (tblobjname "layer" lay-nam)
(progn
(if (/= (strcase (getvar "clayer")) (strcase lay-nam))
(setq oldlayer (getvar "clayer"))
(progn
(if (= oldlayer nil)
(setq oldlayer lay-nam)
)
)
)
(layeron lay-nam)
(setvar "clayer" lay-nam)
)
(progn
(vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list *lays lay-nam)))
(setq layobj (vla-item *lays lay-nam))
(if (not (tblobjname "ltype" ltype)) ;添加线型.
(progn
(setq ltypesobj (vla-get-linetypes *doc))
(vla-load ltypesobj ltype (findfile "acad.lin"));>>> 要加强，在多个*.lin寻找
(vlax-release-object ltypesobj)
)
)
(vla-put-layeron layobj :vlax-true)
(vla-put-lock layobj :vlax-false)
(vla-put-color layobj color)
(if (= (strcase (getvar "clayer")) (command "layer" "on" "" "")(strcase lay-nam)) ;解冻.
(vla-put-freeze layobj :vlax-false)
)
(vla-put-linetype layobj LTYPE)
(vla-put-plottable layobj (if plotk :vlax-true :vlax-false))
)
)
)
(xlr-autolayer) ;加载启动!以下是最大块包围框
;;;几何关系判断
(defun c:tt (/ box e i ss lst bound rects)
(defun ebox (e / pa pb)
(and (= 'ename (type e)) (setq e (vlax-ename->vla-object e)))
(vlax-invoke-method e 'GetBoundingBox 'pa 'pb)
(setq pa (trans (vlax-safearray->list pa) 0 1)
pb (trans (vlax-safearray->list pb) 0 1)
)
(list pa pb)
)
(defun area (pts) (apply '* (cdr (reverse (apply 'mapcar (cons '- pts)))))) ;_求面积
(defun pt4 (pt2)
(list (car pt2) (list (caadr pt2) (cadar pt2)) (cadr pt2) (list (caar pt2) (cadadr pt2)))
) ;_对角点生成四角点
(defun PtInPoly (pt pts)
(equal pi
(abs
(apply '+ (mapcar '(lambda (x y) (rem (- (angle pt x) (angle pt y)) pi)) (cons (last pts) pts) pts))
)
1e-6
)
) ;_点是否在凸多边形内（角度法）
;;
(setq ss (ssget '((0 . "INSERT"))))
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(setq lst (cons (ebox e) lst)) ;_提取边界对角点，不生产矩形
)
(setq lst (vl-sort lst '(lambda (x1 x2) (> (area x1) (area x2))))) ;_按面积大小排序
(while lst
(setq rects (cons (car lst) rects)) ;_矩形对角点集
(setq bound (pt4 (car lst))) ;_矩形边界
(setq lst (vl-remove-if '(lambda (x) (and (PtInPoly (car x) bound) (PtInPoly (cadr x) bound))) (cdr lst))) ;_移除大矩形边界内的小矩形
)
(mapcar '(lambda (x) (command-s "rectang" (car x) (cadr x))) rects) ;_批量生成矩形
(princ)
)
反应器慎用呀，有些毫不相干的，也有影响。 自动图层有问题，也没什么用，关闭就是了。
不明白自动图层有什么作用？
DIM
TEXTLAYER
也可以分层。
自动图层以前还是用的，在 AutoCAD 陆续提供了 DIMLAYER，TEXTLAYER， HPLAYER 之后，基本上可以不需要了。 我从来不用自动图层
要分的图元会在插件加上图层，颜色。
自动图层命令也只能改 command 生成的图元。 e2002 发表于 2024-6-25 08:51
自动图层以前还是用的，在 AutoCAD 陆续提供了 DIMLAYER，TEXTLAYER， HPLAYER 之后，基本上可以不需要了。
哪个版本开始提供的呀？ gzcsun 发表于 2024-6-25 08:30
自动图层有问题，也没什么用，关闭就是了。
不明白自动图层有什么作用？
DIM
我还真不知道高版本已经做成自带的命令了。。。谢谢
页:
[1]