LISP中 remove-if-not 及 remove-if

最新推荐文章于 2024-08-27 08:44:42 发布
最新推荐文章于 2024-08-27 08:44:42 发布
阅读量1.7k 收藏
点赞数
CC 4.0 BY-SA版权
分类专栏： LISP
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.youkuaiyun.com/fengda2870/article/details/9080777 


CL-USER> (remove-if-not #'evenp '(1 2 3 4 ))
(2 4)



CL-USER> (remove-if #'evenp '(1 2 3 4 ))
(1 3)

lisp pause 坐标值_关于多段线 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - 多段线,曲线,中点,坐标,凸度 - Powered by D...
weixin_39892460的博客
12-21 1343
本帖最后由 自贡黄明儒 于 2014-11-7 09:43 编辑;;164.1 [功能] 曲线是否封闭;;164.2 [功能]使多段线封闭;;164.3 [功能] 多段线端点列表;;164.4 [功能] 矩形中点坐标;;164.5 [功能] 参数param处的切线方向的角度;;164.6 [功能] 参数param处的法线方向的角度;;164.7 [功能] 曲线一点的切线方向的角度;;164.8 [...
entmake lisp 对齐_分享：entmake创建图层 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
weixin_39587029的博客
01-12 1039
(defun c:MakeLayers nil (vl-load-com);; © Lee Mac 2010;;----------------------------------------------------------------------------------------------;;;; Specifications: ...
remove_if用法
zhongkeli的专栏
11-05 3634
remove_if function template template ForwardIterator remove_if ( ForwardIterator first, ForwardIterator last, Predicate pred ); Remove e
remove_if的误区
编程资料大全
08-21 90
template<class ForwIter, class Predicate> ForwIter std::remove_if(ForwIter beg, ForwIter end, Predicate op) { beg=find_if(beg,end,op); if(beg==end){ return beg; } else ...
remove_if 的用法
明了的博客
04-18 1万+
remove_if 是一个有很欺骗性的函数。 我们进入它的源码看看它的内部实现remove_if(_ForwardIterator __first, _ForwardIterator __last, _Predicate __pred) { __first = _VSTD::find_if<_ForwardIterator, typename add_lvalue_reference<_P
删除-2-remove-if
嗑盐工作室
09-23 127
#include&lt;iostream&gt; #include&lt;string&gt; #include&lt;list&gt; #include&lt;set&gt; #include&lt;algorithm&gt; #include&lt;functional&gt; using namespace std; void print(list&lt;int&gt; &amp
lisp判断选区是否有对象_cad如何快速删除矩形框之外的图形?比如:
weixin_35931648的博客
01-12 1090
使用AutoCAD命令【ERASE】->空格->输入【ALL】->空格->输入【R】->空格。选择对象，回车，那么除了被选择的对象，其它的对象会被删除。如果使用小插件的话，选择矩形【多段线】或其它的封闭多段线，就可以删除矩形框以外的对象。代码如下：(defun C:TES ( / #g1 &kw &ss1 ent x) (if (and (setq ...
lisp将jpg放入sld图库_图库 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
weixin_39566593的博客
02-01 731
;20150401 增加删除确认.(defun c:tk ();(setvar "cmdecho" 0)(vl-load-com)(setq path "D:\\百度云同步盘\\CAD\\程序\\研究衍伸\\自制幻灯片\\");可不用设置搜索目录(setq keylst '("a1" "a2" "a3" "a4" "a5" "a6" "a7" "a8" "a9"));将image key 设置成表...
老古董Lisp实用主义入门教程（6）：好奇先生在Lisp的花园里挖呀挖呀挖
withstand的博客
08-27 1072
这就是Lisp最为独特的地方，Lisp的运行环境（REPL）中的符号都是动态的，可以被修改，可以被重新定义，可以被删除。这里有一个Lisp的核心概念，一个运行的环境中所有的符号、绑定都可以很容易的存成一个文件，然后在另一个环境中重新加载，这就是Lisp的强大之处。可以看到这个函数的签名，以及参数列表，返回值的类型，文档描述，函数的源代码文件位置。文档字符串内的搜索是可选的。好奇先生还没来得及按下回车，挠痒痒先生的手从很远的地方伸过来，挠了一下好奇先生的咯吱窝，然后还按了一下键盘，好奇先生的命令就被执行了。
lisp调用dcl单选框_晓东CAD家园-论坛-A/VLISP-[求助]：请问如何实现点击dcl对话框中按钮执行lisp程序!-请问如何实现点击dcl对话框中按钮执行lisp程序!我想把积累的lisp...
weixin_39585795的博客
12-21 250
似水无痕 ,你好,你能帮我写个范例吗?因本人愚昧,很喜欢这个.代码:加宽直线(defun c:lw()(progn(write-line"\n 选择实体：")(setq selet (ssget)))(setq pw (getreal "\n输入线宽："))(setq n 0)(if(/= selet nil)(repeat(sslength selet)(setq entname(ssname ...
lisp不是函授型语言_lisp函数大全详解
weixin_39964869的博客
12-21 811
lisp函数大全详解AutoLISP提供了大量的预定义函数。若将函数名(大小写都可)作为表中的第一个元素函数变元(若有的话)作为表中后面的元素，就可以调用那个函数。本章按字母顺序列出AutoLISP所有基本函数。用户会发现其中许多函数都是标准函数，可在LISP程序设计语言中找到。还有一些函数是由 AutoCAD提供的且专用于交互图形环境。1 FLATLAND 系统变量－－与老版本的兼容性AutoL...
lisp块改色_lisp函数(删除带颜色图元)
weixin_39804329的博客
12-21 1398
以下程序在别人的贴子里贴过.为了说明问题,今天再贴一次.改颜色的LISP程序(defun c:c1()(ssget)(command "chprop" "p" "" "c" "1" "") (princ))(defun c:c2()(ssget)(command "chprop" "p" "" "c" "2" "") (princ))(defun c:c3()(ssget)(command "ch...
lisp 删除编组中图元_2013-09-05 明经 AutoLISP 编程(102918348) 群聊记录：删除列表中第N个元素是用哪个函数？vl-remove 是把列表里相同都会删掉...
weixin_39938522的博客
12-21 703
[LC100]建筑设计 16:03:09(defunc:test(/ssneelp21p22p23p24tcbl)(setqss(ssget))(setqn0);序号的初值为0(repeat(sslengthss);重复执行，执行的次数等于所选对象的个数(setqe(ssnamessn));得到选择集内第n个对象的图元名(setqel(entge...
std:;remove_if用法讲解
热门推荐
KFLING的博客
05-03 4万+
remove_if(begin,end,op); remove_if的参数是迭代器，前两个参数表示迭代的起始位置和这个起始位置所对应的停止位置。最后一个参数：传入一个回调函数，如果回调函数返回为真，则将当前所指向的参数移到尾部。返回值是被移动区域的首个元素。remove_if在头文件algorithm中，故要使用此函数，需添加#include &lt;algorithm&gt;由于remove_...
AutoLisp的扩展函数记录
Cronus Z的博客
11-21 5538
(vl-load-com) 加载AutoLISP反应器支持函数和其他 AutoLISP 扩展 表操作函数 (vl-remove 1 '(1 2 3 4)) 返回值:’(2 3 4) ,函数从列表删除指定数 (vl-position 1 '(2 3 1)) 返回值:2 ,函数获得数在列表中位置 (vl-sort '(1 1 2 2 3 3) 返回值:’(1 2 3) ,自动去重 (vl-l...
cad剪裁地形图lisp_晓东CAD家园-论坛-A/VLISP-关于如何计算XClip剪裁边界顶点坐标的研究-我们知道，对于图块的边界剪裁，可以使用XClip命令，使得剪裁边界之外的部分不可见！我们可...
weixin_35794072的博客
03-05 645
;;修改XCLIP边界(defun c:tt ()(while(and(setq e (car(entsel "\n选择剪裁块:")))(setq Poly (car(entsel "\n选择剪裁边界:"))))(gxl-EditXclipBoundary e poly))(princ));;(gxl-EditXclipBoundary ENAME BOUNDARY) 重构XCLip的剪裁边界,参...
Lisp语言中的if语句
m0_68824353的博客
08-05 1623
之后我们要在if语句的参数内写入一个条件，这个条件会使用到=这个特殊的函数，它用于两个数之间的对比，与其他编程语言中的操作符==是同一个的意思。所以if语句的条件是1是否等于1，条件为T，使用了noe函数会把条件的值颠倒，所以if语句的值为假，所以执行的是条件为假的语句。介绍了在if语句的条件里最为常见的函数，我们是时候该讲解最后一个逻辑函数not函数了，即便not函数不是特别常用，它可以将我们的条件从假变为真，从真变为假。or函数的特点就是只要函数中有一个参数或两个参数为真，if语句的条件就为真。....
lisp读写cass属性_cass提取宗地属性lisp程序
weixin_39997310的博客
12-21 596
(vl-load-com);; 条目名称 SOUTHDIJI;;选择宗地界址线(defun c:bak () ;; 获得JZD层上的闭合线选择集，必须带有扩展数据("SOUTH" (1000 . "300000"))。 (setq ss (ssget "x" '((0 . "*LINE") (8 . "JZD") (-4 . "&=") (70 . 1) (-3 ("SOUTH"...
lisp提取长方形坐标_求修改lisp程序，如何提取CAD中多个点的坐标，（本人想提取UCS坐标系）另外只需要提取X,Y值，不要Z...
weixin_39636696的博客
12-21 550
(defun c:tqzb (/) (setq cm (getvar "cmdecho")) (setvar "cmdecho" 0) (if (setq wjm (getfiled "请指定2113要保存的坐标5261文件4102" "e:\\" "txt" 1)) (if (setq ssa (ssget '((0 . "LWPOLYLINE")))) ...
(defun c:OrthoDim ( / *error* ss plObj closedPts refPt dir dimLayer dimStyle upperPts lowerPts leftPts rightPts) (vl-load-com) ;; 错误处理函数 (defun *error* (msg) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\n错误: " msg)) ) (setvar "CMDECHO" 1) (princ) ) ;; 选择闭合多段线 (princ "\n选择闭合多段线: ") (setq ss (ssget ":S" '((0 . "LWPOLYLINE")))) (if (null ss) (progn (alert "未选择对象或选择无效!") (exit)) ) (setq plObj (vlax-ename->vla-object (ssname ss 0))) ;; 检查是否闭合 (if (not (vlax-get-property plObj 'Closed)) (progn (alert "所选多段线未闭合!") (exit)) ) ;; 获取顶点坐标 (setq closedPts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (vlax-vla-object->ename plObj)) ) ) ) ;; 移除重复的闭合点 (if (equal (car closedPts) (last closedPts) 1e-6) (setq closedPts (reverse (cdr (reverse closedPts)))) ) ;; 获取参照点 (setq refPt (getpoint "\n在轮廓线上拾取参照点: ")) (if (null refPt) (exit)) ;; 选择标注方向 (initget "H V") (setq dir (getkword "\n选择标注方向 [H水平/V垂直]: ")) (if (not dir) (setq dir "H")) ;; 获取当前标注样式和图层 (setq dimLayer (getvar "CLAYER")) (setq dimStyle (getvar "DIMSTYLE")) (setvar "CMDECHO" 0) (cond ((= dir "H") ; 水平方向标注 ;; 分组点集: 上方点(Y ≥ refPt Y) 和 下方点(Y ≤ refPt Y) (setq upperPts (vl-sort (vl-remove-if-not '(lambda (pt) (>= (cadr pt) (cadr refPt))) closedPts ) '(lambda (a b) (< (car a) (car b))) ) ) (setq lowerPts (vl-sort (vl-remove-if-not '(lambda (pt) (<= (cadr pt) (cadr refPt))) closedPts ) '(lambda (a b) (< (car a) (car b))) ) ) ;; 去重处理 (setq upperPts (LM:Unique upperPts)) (setq lowerPts (LM:Unique lowerPts)) ;; 计算标注位置 (setq upperY (apply 'max (mapcar 'cadr upperPts))) (setq lowerY (apply 'min (mapcar 'cadr lowerPts))) (setq upperDimLineY (+ upperY 30)) (setq lowerDimLineY (- lowerY 30)) ;; 创建上方标注 (if (> (length upperPts) 1) (progn (command "_.DIMLINEAR" (car upperPts) (cadr upperPts) (list (car (car upperPts)) upperDimLineY) ) (command "_.DIMCONTINUE") (foreach pt (cddr upperPts) (command pt) ) (command "") ) ) ;; 创建下方标注 (if (> (length lowerPts) 1) (progn (command "_.DIMLINEAR" (car lowerPts) (cadr lowerPts) (list (car (car lowerPts)) lowerDimLineY) ) (command "_.DIMCONTINUE") (foreach pt (cddr lowerPts) (command pt) ) (command "") ) ) ) ((= dir "V") ; 垂直方向标注 ;; 分组点集: 右侧点(X ≥ refPt X) 和 左侧点(X ≤ refPt X) (setq rightPts (vl-sort (vl-remove-if-not '(lambda (pt) (>= (car pt) (car refPt))) closedPts ) '(lambda (a b) (< (cadr a) (cadr b))) ) ) (setq leftPts (vl-sort (vl-remove-if-not '(lambda (pt) (<= (car pt) (car refPt))) closedPts ) '(lambda (a b) (< (cadr a) (cadr b))) ) ) ;; 去重处理 (setq rightPts (LM:Unique rightPts)) (setq leftPts (LM:Unique leftPts)) ;; 计算标注位置 (setq rightX (apply 'max (mapcar 'car rightPts))) (setq leftX (apply 'min (mapcar 'car leftPts))) (setq rightDimLineX (+ rightX 30)) (setq leftDimLineX (- leftX 30)) ;; 创建右侧标注 (if (> (length rightPts) 1) (progn (command "_.DIMLINEAR" (car rightPts) (cadr rightPts) (list rightDimLineX (cadr (car rightPts))) ) (command "_.DIMCONTINUE") (foreach pt (cddr rightPts) (command pt) ) (command "") ) ) ;; 创建左侧标注 (if (> (length leftPts) 1) (progn (command "_.DIMLINEAR" (car leftPts) (cadr leftPts) (list leftDimLineX (cadr (car leftPts))) ) (command "_.DIMCONTINUE") (foreach pt (cddr leftPts) (command pt) ) (command "") ) ) ) ) (setvar "CMDECHO" 1) (princ "\n正交标注创建完成!") (princ) ) ;; 辅助函数: 列表去重 (defun LM:Unique (l / x r) (while l (setq x (car l) l (vl-remove x (cdr l)) r (cons x r) ) ) (reverse r) )
最新发布
06-29
<think>这是一个AutoLISP程序，用于在AutoCAD中为闭合多段线创建正交标注（水平或垂直方向）。程序允许用户选择一条闭合的多段线，然后根据用户选择的参照点和标注方向（水平或垂直）自动创建连续标注。 ###程序功能：1.选择一条闭合的多段线。2.在轮廓线上拾取一个参照点，用于确定标注的分组（例如，参照点上方和下方用于水平标注，左侧和右侧用于垂直标注）。3.选择标注方向（水平或垂直）。4.自动将多段线的顶点按照参照点分组（水平方向分为上下两组，垂直方向分为左右两组），然后对每组点进行排序。5.为每组点创建连续标注（DIMCONTINUE），标注线位于多段线轮廓外一定距离（30个单位）。 ###代码分析：####1.错误处理函数 `*error*`-用于捕获错误，当用户取消或发生错误时恢复系统变量并显示错误信息。####2.选择闭合多段线-使用 `ssget`选择单个闭合多段线（LWPOLYLINE）。-检查所选对象是否闭合，如果不闭合则退出。 ####3.获取多段线顶点-使用`entget`获取多段线的图元数据，过滤出顶点（组码10）。-移除重复的闭合点（如果首尾点相同，则移除尾点）。####4.获取参照点和标注方向-使用 `getpoint`获取参照点。-使用`initget`和`getkword`让用户选择水平（H）或垂直（V）标注方向。 ####5.分组顶点-水平标注（H）：-将顶点分为两组：Y坐标大于等于参照点Y坐标的（上方点）和小于等于的（下方点）。-每组按X坐标升序排序。-垂直标注（V）：-将顶点分为两组：X坐标大于等于参照点X坐标的（右侧点）和小于等于的（左侧点）。-每组按Y坐标升序排序。-使用辅助函数 `LM:Unique`去除重复点（确保每个点只出现一次）。 ####6.计算标注位置-水平标注：-上方标注线位于最高点的上方30单位处。-下方标注线位于最低点的下方30单位处。-垂直标注：-右侧标注线位于最右点的右侧30单位处。-左侧标注线位于最左点的左侧30单位处。 ####7.创建连续标注-使用`DIMLINEAR`创建第一个标注，然后使用`DIMCONTINUE`创建连续的标注。-对每组点（至少两个点）创建连续标注。 ####8.辅助函数`LM:Unique`-用于去除列表中的重复元素。 ###使用示例：1.加载程序后，在AutoCAD命令行输入 `OrthoDim`。 2.选择一条闭合多段线。 3.在多段线上拾取一个参照点（该点用于确定分组边界）。 4.选择标注方向（水平或垂直）。5.程序自动创建标注。 ###注意事项： -该程序假设多段线是闭合的，且为轻量多段线（LWPOLYLINE）。 -标注的偏移距离固定为30个单位，可以根据需要修改。 -程序使用当前标注样式和当前图层。###改进建议： 1.允许用户输入标注线的偏移距离。 2.处理非轻量多段线（如旧式的POLYLINE）。 3.考虑多段线可能有圆弧段（当前程序只处理直线段，因为只获取了顶点，圆弧段需要另外处理）。###相关问题：§§相关问题§§: 1.如何修改程序以支持用户自定义标注偏移距离？2.如何处理多段线中的圆弧段（即如何获取圆弧段的端点）？3.如何使标注文字始终朝外（避免被多段线轮廓遮挡）？4.如何扩展程序以支持非闭合多段线？</think>这个AutoLISP程序用于在AutoCAD中为闭合多段线创建正交标注。我将详细解释其工作原理并提供优化建议： ### 程序功能分析 1. **核心功能**：为闭合多段线创建水平/垂直方向的连续尺寸标注 2. **工作流程**： - 选择闭合多段线 - 拾取参照点确定标注区域 - 选择水平(H)或垂直(V)标注方向 - 自动分组顶点并创建连续标注 ### 关键代码解析 ```lisp ;; 错误处理函数 (defun *error* (msg) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\n错误: " msg)) ) (setvar "CMDECHO" 1) (princ) ) ``` - 错误处理逻辑：过滤用户中断操作，恢复系统变量 ```lisp ;; 获取多段线顶点 (setq closedPts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) ; 筛选组码10(顶点坐标) (entget (vlax-vla-object->ename plObj)) ) ) ) ``` - 使用AutoLISP图元数据处理函数提取多段线顶点 ```lisp ;; 水平标注分组逻辑 (setq upperPts (vl-sort (vl-remove-if-not '(lambda (pt) (>= (cadr pt) (cadr refPt))) ; Y坐标≥参照点 closedPts ) '(lambda (a b) (< (car a) (car b))) ; 按X坐标排序 ) ) ``` - 基于参照点将顶点分为上下两组 - 使用vl-sort进行坐标排序 ```lisp ;; 创建连续标注 (command "_.DIMLINEAR" (car upperPts) (cadr upperPts) (list (car (car upperPts)) upperDimLineY) ; 标注线位置 ) (command "_.DIMCONTINUE") (foreach pt (cddr upperPts) (command pt) ) ``` - 使用DIMLINEAR创建首个标注 - DIMCONTINUE创建连续标注链 ### 优化建议 1. **增加用户交互**： ```lisp ;; 添加标注偏移距离输入 (setq offset (getdist "\n标注线偏移距离 <30>: ")) (if (null offset) (setq offset 30)) ``` 2. **改进顶点处理**： ```lisp ;; 处理带圆弧的多段线 (setq coords (vlax-invoke plObj 'Coordinates)) (setq closedPts nil) (repeat (/ (length coords) 2) (setq closedPts (cons (list (car coords) (cadr coords)) closedPts)) (setq coords (cddr coords)) ) ``` 3. **标注位置计算优化**： ```lisp ;; 动态计算标注位置 (setq bbox (vla-getBoundingBox plObj 'minpt 'maxpt)) (setq upperDimLineY (+ (cadr (vlax-safearray->list maxpt)) offset)) ``` ### 使用说明 1. 加载程序后在CAD输入`OrthoDim` 2. 选择闭合多段线 3. 在轮廓线上拾取参照点 4. 选择标注方向(H/V) 5. 程序自动生成正交连续标注 ### 注意事项 - 仅适用于直线段组成的闭合LWPOLYLINE - 标注样式使用当前DIMSTYLE - 标注图层使用当前图层
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值