CAD lisp实用小程序（源代码）
一、圆自动同心
(defun c:TX(/qi aa ec center v_c)
(vl-load-com)
(princ"圆自动同心:")
(setq aa(ssget));；获取圆的图元名
(setq center(getpoint"选取点位置："));
(setq center(vlax-3D-point center));
(setq qi0)；初始序号
(repeat(sslength aa)；对象个数
(setq ec(ssname aa qi))；选择第一个图元
(setq v_c(vlax-ename->vla-object ec))；将圆的图元名转换为VLA对象
(vla-put-center v_c center)；更新圆中心点
(setq qi(+qi1))
);repeat
(princ"修改成功:")
);defun
二、图层快速修改
(princ"快速修改图层编程-TC")
(defun C:TC(/)
(vl-load-com)
(setq SET_ZJTC(vla-get-Layer(vlax-ename->vla-object(car(entsel"\n选择基准图层:"))))) (WHILE(NO
T SET_ZJTC)(setq SET_ZJTC(vla-get-Layer(vlax-ename->vla-object(car(entsel "\n基准图层为空，重新选择！:"))))))
(setq SET_XGTC(vla-get-Layer(vlax-ename->vla-object(car(entsel"\n选择修改图层:"))))) (WHILE(NOT SET_XGTC)(setq SET_XGTC(vla-get-Layer(vlax-ename->vla-object(car (entsel"\n修改图层为空，重新选择！:"))))))
(vlax-for VLA_MSP(vla-get-ModelSpace(vla-get-ActiveDocument(vlax-get-Acad-Object))) (IF(=(vla-get-Layer VLA_MSP)SET_XGTC)(vla-put-Layer VLA_MSP SET_ZJTC))) (princ"\n快速修改图层编程-TC:")
(princ)
);DEFUN
三、字高自动修改
(princ"快速修改字高编程-ZG")
(defun C:ZG(/)
(vl-load-com)
(setq SET_ZTGD(vla-get-Height(vlax-ename->vla-object(car(entsel"\n选择基准字高:"))))) (WHILE(NOT SET_ZJTC)(setq SET_ZJTC(vla-get-Height(vlax-ename->vla-object(car (entsel"\n基准字高为空，重新选择！:"))))))
vbs小程序代码大全
(setq SET_XGTC(vla-get-Layer(vlax-ename->vla-object(car(entsel"\n选择修改图层:"))))) (WHILE(NOT SET_XGTC)(setq SET_XGTC(vla-get-Layer(vlax-ename->vla-object(car (entsel"\n修改图层为空，重新选择！:"))))))
(vlax-for VLA_MSP(vla-get-ModelSpace(vla-get-ActiveDocument(vlax-get-Acad-Object))) (IF(=(vla-get-Layer VLA_MSP)SET_XGTC)(vla-put-Height VLA_MSP SET_ZTGD))) (princ"\n快速修改图层编程-ZG")
(princ)
);DEFUN

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。