设置当前层？
请高手帮忙修改下附件代码选中主视图时，将其图层设置为当前层（这样在生成侧视图时，能与主视图图层相同），感谢！！！
如下：
***************************************************************
***********************画侧视图********************************
(defun c:CB (/ pt1 pt2 pt3 pt4 Y1 Y2 midY
lineYnewY1newY2X1 X2 midX lineXnewX1
newX2newpt1 newpt2 newpt3 newpt4 maxy miny minx maxx lls llss PDDXY PDDX PDDY
)
(setvar "cmdecho" 0)
(command "undo" "be")
(if (null PARTW)(setq PARTW 80))
(setq LLS PARTW)
(setq LLS (getdist (strcat "\n请输入零件厚度:<" (RTOS LLS) ">")))
(if (not lls)(setq lls PARTW))
(setq PARTW LLS)
(setq DIMDD 20)
(C:GETBOXCB)
(if (= des-GetBox-OK 1)
(progn
(setq pt1 des-GetBox-top-pt1)
(setq pt2 des-GetBox-bottom-pt2)
(setq pt3 des-GetBox-left-pt3)
(setq pt4 des-GetBox-right-pt4)
(setq maxy (cadr pt1))
(setq miny (cadr pt2))
(setq minx (car pt3))
(setq maxx (car pt4))
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq oldcolor (getvar "CECOLOR"))
(setvar "CECOLOR" "256")
(princ (strcat "\n***************************************
*****当前厚度:" (rtos PARTW) "mm,距离:" (rtos DIMDD) "mm****"))
(SETQ PDDXY (GETPOINT "\n选择方向点:(下侧或右侧,点右下侧同时绘制两个方向) ")
PDDX(CAR PDDXY)
PDDY(CADR PDDXY))
(if (> PDDX MAXX) (progn (dimmX)))
(if (< PDDY MINY)(progn (dimmY)))
(setvar "osmode" os)
(command "undo" "e")
)
(Princ "\n------无对象?!")
)
(Princ "\n-----------侧视图已经绘制，------------")
(prin1)
)
(defun dimmX()
(setq newpt1 (list (+ maxx DIMDD) maxy)) ;X向侧视图的左上角
(setq newpt2 (list (+ (+ maxx DIMDD) PARTW) MINY));X向侧视图的右下角
(setq newpt3 (list (+ maxx DIMDD)MinY)) ;X向侧视图的左下角
(setq newpt4 (list (+ (+ maxx DIMDD) (/ PARTW 2)) (- MINY 6)));坐标放置位置
(command "RECTANGLE" newpt1 newpt2)
(setvar "CECOLOR" oldcolor)
(command "dimlinear" newpt2 newpt3newpt4))
(defun dimmY()
(setq newpt1 (list minx (- miny DIMDD))) ;y向侧视图的左上角
(setq newpt2 (list maxx (- miny (+ DIMDD PARTW)))) ;y向侧视图的右下角
(setq newpt3 (list maxx (- miny DIMDD))) ;y向侧视图的右上角
(setq newpt4 (list (+ maxx 6) (- miny (+ DIMDD (/ PARTW 2)))));坐标放置位置
(command "RECTANGLE" newpt1 newpt2)
(setvar "CECOLOR" oldcolor)
(command "dimlinear" newpt2 newpt3newpt4))
(defun c:GetBoxCB (/ des-GetBox-en1 ename-name
vlaobject-ename-name
)
(setq des-GetBox-en1 nil)
(setq des-GetBox-OK nil)
(setq des-GetBox-en1 (entsel "\n选取零件外形(复线)... "))
(vl-load-com)
(while des-GetBox-en1
;;;当en1存在时，做以下内容，直到en1不存在为止
(sub-GetBoundingBox des-GetBox-en1)
(setq des-GetBox-en1 nil)
)
(prin1)
)
(defun sub-GetBoundingBox (des-GetBox-en1)
;;;(command "ucs" "w")
(setq ename-name (car des-GetBox-en1))
(setq vlaobject-ename-name
(vlax-ename->vla-object ename-name)
)
(vla-GetBoundingBox
vlaobject-ename-name
'minpoint
'maxpoint
)
(setq minpoint (vlax-safearray->list minpoint))
(setq maxpoint (vlax-safearray->list maxpoint))
(setq minpoint(trans minpoint 0 1)) ;转为ucs点
(setq maxpoint(trans maxpoint 0 1)) ;转为ucs点
(setq des-GetBox-top-pt1 maxpoint)
(setq des-GetBox-bottom-pt2 minpoint)
(setq des-GetBox-left-pt3 minpoint)
(setq des-GetBox-right-pt4 maxpoint)
(setq des-GetBox-midpt (polar minpoint
(angle minpoint maxpoint)
(/(distance minpoint maxpoint) 2.0)
))
(setq des-GetBox-OK 1)
(princ "\nReturn-BoundingBox-ok")
)
不知道是不是这个意思
本帖最后由 print1985 于 2020-12-18 23:04 编辑(defun c:CB (/ pt1 pt2 pt3 pt4 Y1 Y2 midY
lineYnewY1newY2X1 X2 midX lineXnewX1
newX2newpt1 newpt2 newpt3 newpt4 maxy miny minx maxx lls llss PDDXY PDDX PDDY
)
(setvar "cmdecho" 0)
(command "undo" "be")
(if (null PARTW)(setq PARTW 80))
(setq LLS PARTW)
(setq LLS (getdist (strcat "\n请输入零件厚度:<" (RTOS LLS) ">")))
(if (not lls)(setq lls PARTW))
(setq PARTW LLS)
(setq DIMDD 20)
(C:GETBOXCB)
(if (= des-GetBox-OK 1)
(progn
(setq pt1 des-GetBox-top-pt1)
(setq pt2 des-GetBox-bottom-pt2)
(setq pt3 des-GetBox-left-pt3)
(setq pt4 des-GetBox-right-pt4)
(setq maxy (cadr pt1))
(setq miny (cadr pt2))
(setq minx (car pt3))
(setq maxx (car pt4))
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq oldcolor (getvar "CECOLOR"))
(setvar "CECOLOR" "256")
(princ (strcat "\n***************************************
*****当前厚度:" (rtos PARTW) "mm,距离:" (rtos DIMDD) "mm****"))
(SETQ PDDXY (GETPOINT "\n选择方向点下侧或右侧,点右下侧同时绘制两个方向) ")
PDDX(CAR PDDXY)
PDDY(CADR PDDXY))
(if (> PDDX MAXX) (progn (dimmX)))
(if (< PDDY MINY)(progn (dimmY)))
(setvar "osmode" os)
(command "undo" "e")
)
(Princ "\n------无对象?!")
)
(Princ "\n-----------侧视图已经绘制，------------")
(prin1)
)
(defun dimmX()
(setq newpt1 (list (+ maxx DIMDD) maxy)) ;X向侧视图的左上角
(setq newpt2 (list (+ (+ maxx DIMDD) PARTW) MINY));X向侧视图的右下角
(setq newpt3 (list (+ maxx DIMDD)MinY)) ;X向侧视图的左下角
(setq newpt4 (list (+ (+ maxx DIMDD) (/ PARTW 2)) (- MINY 6)));坐标放置位置
(command "RECTANGLE" newpt1 newpt2)
(setvar "CECOLOR" oldcolor)
(command "dimlinear" newpt2 newpt3newpt4))
(defun dimmY()
(setq newpt1 (list minx (- miny DIMDD))) ;y向侧视图的左上角
(setq newpt2 (list maxx (- miny (+ DIMDD PARTW)))) ;y向侧视图的右下角
(setq newpt3 (list maxx (- miny DIMDD))) ;y向侧视图的右上角
(setq newpt4 (list (+ maxx 6) (- miny (+ DIMDD (/ PARTW 2)))));坐标放置位置
(command "RECTANGLE" newpt1 newpt2)
(setvar "CECOLOR" oldcolor)
(command "dimlinear" newpt2 newpt3newpt4))
(defun c:GetBoxCB (/ des-GetBox-en1 ename-name
vlaobject-ename-name
)
(setq des-GetBox-en1 nil)
(setq des-GetBox-OK nil)
(setq des-GetBox-en1 (entsel "\n选取零件外形(复线)... "))
(vl-load-com)
(while des-GetBox-en1
;;;当en1存在时，做以下内容，直到en1不存在为止
(setvar "CLAYER" (cdr (assoc 8 (entget (car des-GetBox-en1)))))
(sub-GetBoundingBox des-GetBox-en1)
(setq des-GetBox-en1 nil)
)
(prin1)
)
(defun sub-GetBoundingBox (des-GetBox-en1)
;;;(command "ucs" "w")
(setq ename-name (car des-GetBox-en1))
(setq vlaobject-ename-name
(vlax-ename->vla-object ename-name)
)
(vla-GetBoundingBox
vlaobject-ename-name
'minpoint
'maxpoint
)
(setq minpoint (vlax-safearray->list minpoint))
(setq maxpoint (vlax-safearray->list maxpoint))
(setq minpoint(trans minpoint 0 1)) ;转为ucs点
(setq maxpoint(trans maxpoint 0 1)) ;转为ucs点
(setq des-GetBox-top-pt1 maxpoint)
(setq des-GetBox-bottom-pt2 minpoint)
(setq des-GetBox-left-pt3 minpoint)
(setq des-GetBox-right-pt4 maxpoint)
(setq des-GetBox-midpt (polar minpoint
(angle minpoint maxpoint)
(/(distance minpoint maxpoint) 2.0)
))
(setq des-GetBox-OK 1)
(princ "\nReturn-BoundingBox-ok")
)
页:
[1]