设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 设置当前层？
返回列表 发新帖
查看: 448|回复: 2

[源码] 设置当前层？

[复制链接]
刘炎华
发表于 2020-12-18 21:25 | 显示全部楼层 |阅读模式
50明经币
请高手帮忙修改下附件代码
选中主视图时，将其图层设置为当前层（这样在生成侧视图时，能与主视图图层相同），感谢！！！
如下：
***************************************************************
***********************画侧视图********************************
(defun c:CB (/            pt1           pt2          pt3         pt4        Y1     Y2     midY
             lineY  newY1  newY2  X1         X2        midX   lineX  newX1
             newX2  newpt1 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 newpt3  newpt4))
(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 newpt3  newpt4))



(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

查看完整内容

(defun c:CB (/ pt1 pt2 pt3 pt4 Y1 Y2 midY lineY newY1 newY2 X1 X2 midX lineX newX1 newX2 newpt1 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 (getdi ...
回复

使用道具 举报

print1985
发表于 2020-12-18 21:25 | 显示全部楼层

不知道是不是这个意思

本帖最后由 print1985 于 2020-12-18 23:04 编辑

(defun c:CB (/            pt1           pt2          pt3         pt4        Y1     Y2     midY
             lineY  newY1  newY2  X1         X2        midX   lineX  newX1
             newX2  newpt1 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 newpt3  newpt4))
(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 newpt3  newpt4))



(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")
)

点评

刘炎华
谢谢！是这个效果！  发表于 2020-12-19 10:02
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-5-20 09:35 , Processed in 0.340663 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表