几个有用的CAD的加载程序LISP (2013-01-10 18:58:27)转载▼

标签： cad加载程序 杂谈分类： CAD应用

1.图层命令

;;; -----------------------------------------------------------------

;;; 2 图层命令

;;; ------------------------------------------------------------------

;;;  2.1 LayerOff 关闭物体所在的层(单选)

(defun c:1 (/ ent lname)

(setvar "cmdecho" 0)

(setq ent (entsel "\nPick an entity on the target layer: "))

(if ent

(progn

(setq ent (entget (car ent)))

(setq lname (cdr (assoc 8 ent)))

)

(setq lname (getstring "\nNot to selected, Input layer name: "))

)

(if (= (getvar "clayer") lname)

(setvar "clayer" "0")

)

(command "layer" "off" lname "")

(princ)

)

;;;  2.2 LayerOffM 关闭物体所在的层(多选)

(Defun C:LayerOffM ()

(setvar "cmdecho" 0)

(prompt "\nSelect entities to turn off:")

(setq ss (ssget))

(if (and

ss

(sslength ss)

0

)

(progn

(setq ct 0

len (sslength ss)

cl (getvar "clayer")

)

(command ".layer")

(while (< ct len)

(setq la (cdr (assoc 8 (entget (ssname ss ct)))))

(if (/= cl la)

(command "off" la)

(progn

(prompt "\nThe layer")

(prompt la)

(prompt "is CURRENT!")

)

)

(if (= old nil)

(setq OLD la)

(setq OLD (strcat OLD "," la))

)

(setq ct (1+ ct))

)

(command "")

)

)

(princ)

(setvar "cmdecho" 0)

(prin1)

)

;;;  2.3 LayerOffOther 关闭物体以外的层

(defun c:LayerOffOther (/ ent lname)

(setvar "cmdecho" 0)

(setq ent (entsel "\nPick an entity on the target layer: "))

(if ent

(progn

(setq ent (entget (car ent)))

(setq lname (cdr (assoc 8 ent)))

(setvar "clayer" lname)

)

)

(command "layer" "off" "*" "n" "")

(princ)

)

;;;  2.3.1 LayerOffOtherM 关闭物体以外的层(多选)

(Defun C:2 (/ ss ct cl la old)

(setvar "cmdecho" 0)

(prompt "\nSelect entities on the layers you want to remain:")

(setq ss (ssget))

(setq ct 0

len (sslength ss)

cl (cdr (assoc 8 (entget (ssname ss 0))))

)

(setvar "clayer" cl)

(while (< ct len)

(setq la (cdr (assoc 8 (entget (ssname ss ct)))))

(if (= old nil)

(setq OLD la)

(setq OLD (strcat OLD "," la))

)

(setq ct (1+ ct))

)

(command ".layer" "off" "*" "n" "")

(command ".layer" "on" old "")

(princ)

)

;;; ------------------------------------------------------------------

;;;  2.4 LayerLockM 锁住物体所在的层(多选)

(defun C:4 (/ ES EN EL A)

(princ "Selected Entity(s) Layers Locked.")

(setq ES (ssget)

A 0

EN ""

EL nil

FL nil

)

(while (/= EN nil)

(setq EN (ssname ES A)

EL (cons EN EL)

A (1+ A)

)

)

(setq EL (cdr EL)

FL (cdr (assoc '8 (entget (car EL))))

EL (cdr EL)

)

(repeat (- A 2)

(setq EN (cdr (assoc '8 (entget (car EL))))

FL (strcat EN "," FL)

EL (cdr EL)

)

)

(command "LAYER" "LO" (eval FL) "")

(princ)

)

;;;  2.5 LayerUnlockM 解锁物体所在的层(多选)

(defun C:5 (/ ES EN EL A)

(princ "Selected Entity(s) Layers Unlocked.")

(setq ES (ssget)

A 0

EN ""

EL nil

FL nil

)

(while (/= EN nil)

(setq EN (ssname ES A)

EL (cons EN EL)

A (1+ A)

)

)

(setq EL (cdr EL)

FL (cdr (assoc '8 (entget (car EL))))

EL (cdr EL)

)

(repeat (- A 2)

(setq EN (cdr (assoc '8 (entget (car EL))))

FL (strcat EN "," FL)

EL (cdr EL)

)

)

(command "LAYER" "U" (eval FL) "")

(princ)

)

;;; ------------------------------------------------------------------

;;;  2.6 LayerFreezeM 冻结物体所在的层(多选)

(defun C:LayerFreezeM (/ ES EN EL A)

(princ "Selected Entity(s) Layers Freezed.")

(setq ES (ssget)

A 0

EN ""

EL nil

FL nil

)

(while (/= EN nil)

(setq EN (ssname ES A)

EL (cons EN EL)

A (1+ A)

)

)

(setq EL (cdr EL)

FL (cdr (assoc '8 (entget (car EL))))

EL (cdr EL)

)

(repeat (- A 2)

(setq EN (cdr (assoc '8 (entget (car EL))))

FL (strcat EN "," FL)

EL (cdr EL)

)

)

(command "LAYER" "F" (eval FL) "")

(princ)

)

;;;  2.7 LayerThawAll 解冻所有的层

(Defun C:LayerThawAll ()

(COMMAND "LAYER" "THAW" "*" "")

(PRINC)

)

;;; ------------------------------------------------------------------

;;;  2.8 LayerCurrent 将物体所在的层设为当前层

(defun c:LayerCurrent (/ ent lname)

(setvar "cmdecho" 0)

(setq ent (car (entsel "\nPick an entity on the target layer: ")))

(if ent

(progn

(setq ent (entget ent)

lname (cdr (assoc 8 ent))

)

)

(progn

(setq lname (getstring "\nNot to selected, Input layer name: "))

)

)

(setvar "clayer" lname)

(princ)

)

;;; ------------------------------------------------------------------

;;;  2.9 LayerOnAll 打开所有层

(Defun C:3 ()

(command "layer" "on" "*" "")

(princ)

)

;;; ------------------------------------------------------------------

;;;  2.10 ToCurrentLayerM 将物体转到当前层(多选)，并使用层颜色，线型

(defun c:ToCurrentLayerM (/ lname ss)

(setq ss (ssget))

(if ss

(progn

(setq lname (getvar "clayer"))

(command "chprop" ss "" "la" lname "color" "bylayer" "ltype" "bylayer"

""

)

)

)

)

;;; ------------------------------------------------------------------

;;;  2.11 ToLayerMatch 通过目标物体改变选择实体的图层属性

(defun c:ToLayerMatch (/ lname ss ent)

(setvar "cmdecho" 0)

(prompt "\nSelect the entity(s): ")

(setq ss (ssget))

(if ss

(progn

(setq ent (entsel "\nPick an entity on the target layer: "))

(if ent

(progn

(setq ent (entget (car ent)))

(setq lname (cdr (assoc 8 ent)))

)

(progn

(setq lname (getstring "\nNot to selected, Input layer name: "))

)

)

(command "chprop" ss "" "la" lname "")

)

)

(princ)

)

快捷键1-掩藏图层  快捷键2-只显示选中图层  快捷键3-显示全部图层

000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000

2.增强复制

;;;********************************************************图形矫正程序-jz

(defun c:cc (/ p1 p2 s e cn)

;__________________

(defun ttt (ss n / m)

(setq ee e

ns (ssadd)

)

(while (setq ee (entnext ee))

(setq ns (ssadd ee ns))

)

(command "erase" ns "")

(command "copy" ss "" "m" "non" p1)

(setq m 0)

(repeat (atoi n)

(setq m (1+ m))

(cond

((= "/" (substr n (strlen n)))

(command

"non"

(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n)))))

p1

p2

)

)

)

(t

(command "non"

(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2)

)

)

)

)

(command)

)

;__________________

(princ "\n选择要复制的物体:")

(setq s (ssget))

(setq p1 (getpoint "\n复制的起点:"))

(setq p2 (getpoint p1 "\n复制的终点:"))

(setq e (entlast))

(command "copy" s "" "non" p1 "non" p2)

(while (/= 0

(atof (setq cn (getstring "\n份数(以 / 结束为等分):")))

)

(ttt s cn)

)

(princ)

)

(defun c:c1 (/ p1 p2 s e cn a1 d1 ns cnn)

;__________________

(defun ttt (ss n / m)

(setq ee e

ns (ssadd)

)

(while (setq ee (entnext ee))

(setq ns (ssadd ee ns))

)

(command "erase" ns "")

(command "copy" ss "" "m" "non" p1)

(if (member (substr n (strlen n)) '("/" "*"))

(progn

(setq m 0)

(repeat (atoi n)

(setq m (1+ m))

(cond

((= "/" (substr n (strlen n)))

(command

"non"

(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n)))))

p1

p2

)

)

)

((= "*" (substr n (strlen n)))

(command "non"

(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2)

)

)

)

)

)

(command "non" (setq p2 (polar p1 a1 (atof n))))

)

(command)

)

;__________________

(princ "\n选择要复制的物体:")

(setq s (ssget))

(setq p1 (getpoint "\n复制的起点:"))

(command "undo" "be" "line" p1 p1 "")

(setq e (entlast))

(command "copy" s "" "non" p1 pause)

(setq p2 (getvar "lastpoint")

a1 (angle p1 p2)

d1 (distance p1 p2)

)

(setq cn "1*")

(while cn

(ttt s cn)

(initget 128)

(princ

"\n输入坐标=复制终点                         输入数值=修改间距 "

)

(princ

"\n输入数值n并以 / 结束=间距内等分n次复制    输入数值n并以 * 结束=按间距复制n次 "

)

(setq cnn (getpoint "\n请按提示输入:"))

(if (= 'LIST (type cnn))

(setq p2 cnn

a1 (angle p1 p2)

d1 (distance p1 p2)

)

(setq cn cnn)

)

)

(entdel e)

(command "undo" "e")

(princ)

)

(defun c:c2 (/ p1 p2 s e cn)

;__________________

(defun ttt (ss n / m)

(setq ee e

ns (ssadd)

)

(while (setq ee (entnext ee))

(setq ns (ssadd ee ns))

)

(command "erase" ns "")

(command "copy" ss "" "m" "non" p1)

(setq m 0)

(repeat (atoi n)

(setq m (1+ m))

(cond

((= "/" (substr n (strlen n)))

(command

"non"

(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n)))))

p1

p2

)

)

)

(t

(command "non"

(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2)

)

)

)

)

(command)

)

;__________________

(princ "\n选择要复制的物体:")

(setq s (ssget))

(setq p1 (getpoint "\n复制的起点:"))

(setvar "lastpoint" p1)

;(setq p2 (getpoint p1 "\n复制的终点:"))

(setq e (entlast))

(command "copy" s "" "non" p1 pause)

(if (not (equal p1 (setq p2 (getvar "lastpoint"))))

(while (/= 0

(atof (setq cn (getstring "\n份数(以 / 结束为等分):")))

)

(ttt s cn)

)

)

(princ)

)

;;;|增强拷贝

(defun c:c3 (/ getpt getpt1 ss ptx pty db n x y gtin)

(setq getpt1 (acet-ss-drag-move

(setq ss (ssget))

(setq getpt (getpoint "\n&点取基点:"))

1

)

)

(setq ptx (- (car getpt1) (car getpt))

pty (- (cadr getpt1) (cadr getpt))

y   0

)

(vl-cmdf ".copy" ss "" getpt getpt1)

(while (setq gtin (- (getint "\n重复次数:") 1))

(vl-cmdf ".undo" "e")

(if (/= y 0)

(vl-cmdf ".u")

)

(setq n  1

x  0

db nil

)

(if (/= y 0)

(vl-cmdf ".u")

)

(vl-cmdf ".undo" "be")

(repeat gtin

(setq db (cons (list (+ (* n ptx) (car getpt1))

(+ (* n pty) (cadr getpt1))

0.0

)

db

)

)

(setq n (1+ n))

)

(repeat (length db)

(vl-cmdf ".copy" ss "" getpt (nth x (reverse db)))

(setq x (1+ x))

)

(vl-cmdf ".undo" "e")

(vl-cmdf ".undo" "be")

(setq y (1+ y))

)

(princ)

)

快捷键C1-等分复制  快捷键C2-多重复制

000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000

3.墙柱工具无敌(雨夜屠夫)

VLX文件，自己上网搜索。

tssd加载lisp_几个有用的CAD的加载程序LISP相关推荐

  1. android调用h5预加载图片,使用HTML5的页面资源预加载(Link prefetch)功能加速你的页面加载速度...

    不管是浏览器的开发者还是普通web应用的开发者,他们都在做一个共同的努力:让Web浏览有更快的速度感觉.有很多已知的技术都可以让你的网站速度变得更快:使用CSS sprites,使用图片优化工具,使用 ...

  2. el-image中src加载assets路径下图片使用require避免加载不到

    场景 el-image中图片的数据源加载assets路径下的照片. 正确加载方式. <el-imagestyle="width: 732px; height: 48px":s ...

  3. sceneManager.loadscene加载场景时不会主动去加载场景的依赖包，要手动加载或添加场景到build setting列表中...

    sceneManager.loadscene加载场景时不会主动去加载场景的依赖包,要手动加载或添加场景到build setting列表中 假设有一场景1001.unity,,manifest文件如下: ...

  4. java spring包_java 自定义加载器，加载spring包，动态加载实现，jar包隔离，tomcat加载webapp方式...

    java 自定义加载器,加载spring包,动态加载实现,jar包隔离,tomcat加载webapp方式 发布时间:2018-08-20 12:02, 浏览次数:774 , 标签: java spri ...

  5. java模块化按需加载,JavaScript模块化之使用requireJS按需加载

    模块加载器的概念可能稍微接触过前端开发的童鞋都不会陌生,通过模块加载器可以有效的解决这些问题: JS文件的依赖关系. 通过异步加载优化script标签引起的阻塞问题 可以简单的以文件为单位将功能模块化 ...

  6. cesium 3dtiles 加载本地数据_深入echarts学习：加载跨域、异步、本地json数据的防坑录

    1 说明: ===== 1.1 推荐指数:★★★★ 1.2 网上这方面说明,大多模棱两可,坑很多,讲透彻的不多,故本人做一个小结. 1.3 我曾介绍echarts的简单基本用法: <Echart ...

  7. html中searchbutton点击没有反应,点击按钮加载完整的HTML后，使用Selenium加载其他元素...

    我想刮一页并收集所有链接.该页面显示30个条目并查看完整列表,点击全部加载按钮是必要的.点击按钮加载完整的HTML后,使用Selenium加载其他元素 我使用下面的代码: from selenium ...

  8. android webview 多次加载,android – 重复webview,我想在每个加载相同

    如何在分屏中显示两个类似的webview,我想复制一个webview,我想同时滚动两个.谢谢 android:layout_width="match_parent" android ...

  9. springboot配置文件加载顺序_「SpringBoot系列」配置文件加载优先级解析

    SpringBoot提供了外部分配置功能,可以使用属性文件(properties).YAML(yml)文件.环境变量和命令行参数来进行处部参数配置,并t以特定的顺序来处理配置,以便于允许合理的覆盖值. ...

  10. 推荐JS插件：imagesLoaded，监测图片加载情况并提供相应的事件（加载成功/失败）...

    惯例,首先贴上imagesLoaded的官方网址:http://imagesloaded.desandro.com/ 第一次知道imagesLoaded这个插件是在做瀑布流布局时,当时选用的是maso ...

最新文章

  1. sklearn使用投票器VotingClassifier算法构建多模型融合的硬投票器分类器（hard voting）并计算融合模型的混淆矩阵、可视化混淆矩阵（confusion matrix）
  2. 一看就知道的Java8日期处理全方位实践
  3. extjs4 textfield width
  4. kali桥接模式无法上网_听没听过用手机接路由器上网？
  5. 普罗米修斯 监控_接近完美的监控系统—普罗米修斯
  6. 程序员法律考试（7）-民法（4）
  7. 二十八、接了一单Python北京空气质量数据处理
  8. 求助！C++ 实践之引入外部头文件失败
  9. python 中基于 xlwings 处理 excel
  10. tarjan用法——割点
  11. 轨道交通计算机联锁系统应用,计算机联锁系统论文(2)
  12. 跨平台局域网文件传输工具——Dukto R5
  13. MATLAB三维散点图的绘制函数详解（scatter3、plot3） （有示例）
  14. Android 图片压缩也即生成缩略图方法
  15. 小米MIUI线刷包cust.img、system.img精简教程（一）
  16. CSDN博客专栏申请方法
  17. JDK 内置实用工具：监视、故障排除
  18. 为什么要学习平面设计的几个理由
  19. CVPR 2019 论文汇总（按方向进行论文划分）
  20. vscode 管理员权限 运行终端

热门文章

  1. 自定义DatetimePicker起始默认值
  2. javascript 逻辑运算符 和 或 非
  3. Nodejs busBoy和fs模块完成文件的上传
  4. PHP将PPT文件转成图片
  5. USB大容量存储类规范概述
  6. English trip V1 - 1.How Do You Feel Now? Teacher:Lamb Key:形容词(Adjectives)
  7. 【建议收藏】六个免费的在线OCR识别网站，显著提高你的工作效率！
  8. Kernel：CC_HAVE_ASM_GOTO 、 Compiler lacks asm-goto support
  9. 基于Bilibili热门视频Top100弹幕的数据爬取与分析（报告版）
  10. python柱状图显示数值_Python实现绘制双柱状图并显示数值功能示例