lisp-format初步格式输出和数字判定

最新推荐文章于 2022-02-16 22:38:56 发布
原创 最新推荐文章于 2022-02-16 22:38:56 发布 · 496 阅读 · 0 ·
CC 4.0 BY-SA版权
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。

本文通过具体示例展示了如何使用解析整数函数，并说明了允许垃圾字符的情况。通过对比不同字符串输入的结果，帮助理解函数的行为。

0] (format t "~a~%~a" "asafadf" "11111")
asafadf
11111
NIL

 

 

0[5] (parse-integer "aaa2":junk-allowed t)

NIL
0
0[5] (parse-integer "5552":junk-allowed t)

5552
4
0[5]

老古董Lisp实用主义入门教程（4）：完美先生的完美Lisp
withstand的博客
08-16 1152
Lisp是一个符号编程语言，符号是Lisp中的对象的代号，符号是Lisp中的变量名、函数名、宏名等等。Lisp的开发过程因为其REPL而高效，可以实时的查看代码的运行结果，可以实时的修改代码，这个功能在Vs Code+Alive中支持的很好，在Emacs中也有很好的支持。直接操作代码，生成代码，求值代码，是Lisp中一个核心理念和功能，在宏中有很好的体现（以后再写）。
《GNU Emacs Lisp编程入门》读书笔记
路途
01-07 2126
列表处理 Lisp列表 e.g. '(this list has (a list inside of it)) Lisp原子 在一个列表中，原子是由空格一一分隔的。原子可以紧接着括号。 从技术上说，Lisp中的一个列表有三种可能的组成方式： 括号和括号中由空格分隔的原子 括号和括号中的其他列表 括号和括号中的其他列表及原子 一个列表可以仅有一个原子或者完全没有原子。一个没有任何原子的列表就像...
判断字符为数字
daxiang_zhang的专栏
02-22 583
public static boolean checknum(String value) ...{        if (value != null && !value.equals("")) ...{            value = value.trim();            String regex = "^/d+?[.]?/d*?$";            Pattern 
lisp format
weixin_34055910的博客
04-13 200
为什么80%的码农都做不了架构师？>>> ...
lisp代码-format t 输出语句
07-16
lisp代码-format t 输出语句
lisp format总结
ryuali2010的专栏
07-18 3199
1: 基本格式化 (format destination control-string &rest format-arguments) (输出目的 控制字符串 格式化参数）  @,冒号 --> 修饰符  ~A,~D  -->控制字符串  V，#，十进制数字  --> 前置参数 （关键是寻找到底是用一个子句） ~A/~S 都可以使用任何类型的格式化参数，~S试图
lisp princ详解_LISP-输入和输出
weixin_39888268的博客
02-17 757
LISP-输入和输出常见的LISP提供许多输入输出功能。我们已经使用了format函数和print函数进行输出。在本节中，我们将研究LISP中提供的一些最常用的输入输出功能。输入功能下表提供了LISP最常用的输入功能-Sr.No.Function & Description1read & optional input-stream eof-error-p eof-value rec...
(defun c:LJM (/ *error* old-osmode ss all-texts i ent txt matches no-section-matches beam-number found-sections new-txt ent-data final-ss pos right-bracket-pos normalized-txt normalized-beam mark-option circle-layer circle-color conflict-color text-height text-rotation circle-center circle-radius beam-prefixes text-box text-width text-height-adjusted processed dash-pos section-text bracket-pos same-beam-matches current-beam-number space-pos last-char first-section-char text-pt original-space-flag has-original-space format-type format-types conflict-beams conflict-layer span-conflict-beams span-conflict-color span-conflict-layer prefix-part number-part processed-count conflict-count span-conflict-count base-beam-name is-conflict existing-entry sections result left-bracket-pos span-number prefix-number conflict-table-text table-insert-point) ;; 自定义 digit-char-p 函数（AutoLISP 替代实现） (defun digit-char-p (char) (and (>= (ascii char) 48) (<= (ascii char) 57)) ) ;; 错误处理函数 (defun *error* (msg) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat " 错误: " msg)) ) (setvar "cmdecho" 1) (setvar "osmode" old-osmode) (princ) ) ;; 初始化设置 (setq old-osmode (getvar "osmode")) (setvar "cmdecho" 0) (setvar "osmode" 0) ;; 标注设置 (setq circle-layer "LJM_MARK") ; 标注图层名 (setq conflict-layer "LJM_CONFLICT"); 冲突标注图层名 (setq span-conflict-layer "LJM_SPAN_CONFLICT") ; 跨数冲突标注图层名 (setq circle-color 1) ; 红色（匹配标注） (setq conflict-color 2) ; 黄色（冲突标注） (setq span-conflict-color 6) ; 洋红色（跨数冲突标注） ;; 定义支持的梁前缀列表（不区分大小写） (setq beam-prefixes '("L" "KL" "WKL" "JCL" "CTL" "DL" "LL" "XL" "LG" "TL" "BL" "FL")) ;; 询问用户是否需要标注 (initget "Y N") (setq mark-option (getkword " 是否需要在匹配截面梁处添加标注? [Y/N] <N>: ")) (if (not mark-option) (setq mark-option "N")) ;; 创建标注图层（如果不存在） (if (not (tblsearch "LAYER" circle-layer)) (command "._-LAYER" "_M" circle-layer "_C" "1" "" "") ) ;; 创建冲突标注图层（如果不存在） (if (not (tblsearch "LAYER" conflict-layer)) (command "._-LAYER" "_M" conflict-layer "_C" "2" "" "") ) ;; 创建跨数冲突标注图层（如果不存在） (if (not (tblsearch "LAYER" span-conflict-layer)) (command "._-LAYER" "_M" span-conflict-layer "_C" "6" "" "") ) (princ " 请框选需要匹配的梁信息: ") (setq ss (ssget '((0 . "*TEXT")))) ; 选择所有文本对象 (setq all-texts (ssadd)) ; 存储所有文本对象 (if ss (progn ;; 第一步：收集所有文本并分类 (setq i 0) (setq matches '()) ; 存储带完整信息的文本 (实体 原始文本 梁编号 截面信息 格式类型 是否有空格) (setq no-section-matches '()) ; 存储只有编号的文本 (实体 原始文本 梁编号 格式类型) (setq conflict-beams '()) ; 存储有冲突的梁编号 (setq span-conflict-beams '()) ; 存储跨数冲突的梁编号 ;; 定义格式类型常量 (setq format-types '( :BRACKET_NO_SPACE ; 带括号无空格，如 XL(1)200*750 :BRACKET_WITH_SPACE ; 带括号有空格，如 XL(1) 200*750 :NO_BRACKET_NO_SPACE ; 无括号无空格，如 XL200*750 :NO_BRACKET_WITH_SPACE ; 无括号有空格，如 XL 200*550 (不太常见) :BRACKET_ONLY ; 只有带括号的编号，如 XL(1) :NO_BRACKET_ONLY ; 只有无括号的编号，如 XL1 :COMPLEX_PREFIX ; 复合前缀格式，如 2A-XL1 200x550 :NUMERIC_PREFIX ; 数字前缀格式，如 4KL14 250x1400 :STANDARD_FORMAT ; 标准格式，如 LL1 200x400 )) (repeat (sslength ss) (setq ent (ssname ss i)) (setq txt (vl-string-trim " \t\r" (cdr (assoc 1 (entget ent))))) ; 清理文本两端的空格 (setq normalized-txt (strcase txt)) ; 转换为大写便于比较 (ssadd ent all-texts) ; 添加到总选择集 ;; 检查是否为梁编号（支持多种格式） (cond ;; 格式8: 标准格式，如 LL1 200x400 或 XL5 200x550 ((and (wcmatch normalized-txt "*L*[0-9]* *[0-9]*[*xX]?*[0-9]*") (vl-some '(lambda (prefix) (wcmatch normalized-txt (strcat prefix "*[0-9]* *[0-9]*[*xX]?*[0-9]*"))) beam-prefixes)) (setq space-pos (vl-string-position 32 normalized-txt)) ; 查找空格位置 (if space-pos (progn (setq beam-number (substr txt 1 space-pos)) ; 提取到空格部分作为编号 (setq section-text (substr txt (1+ space-pos))) ; 提取空格后面的截面信息 (setq original-space-flag T) ; 明确标记有空格 (setq matches (cons (list ent txt beam-number section-text :STANDARD_FORMAT original-space-flag) matches)) ) (setq no-section-matches (cons (list ent txt txt :STANDARD_FORMAT nil) no-section-matches)) ; 整个文本作为编号 ) ) ;; 格式7: 数字前缀格式，如 4KL14 250x1400 ((and (wcmatch normalized-txt "[0-9]*L*[0-9]* *[0-9]*[*xX]?*[0-9]*") (vl-some '(lambda (prefix) (wcmatch normalized-txt (strcat "[0-9]*" prefix "*[0-9]* *[0-9]*[*xX]?*[0-9]*"))) beam-prefixes)) (setq space-pos (vl-string-position 32 normalized-txt)) ; 查找空格位置 (if space-pos (progn (setq beam-number (substr txt 1 space-pos)) ; 提取到空格部分作为编号（包括前缀数字） (setq section-text (substr txt (1+ space-pos))) ; 提取空格后面的截面信息 (setq original-space-flag T) ; 明确标记有空格 (setq matches (cons (list ent txt beam-number section-text :NUMERIC_PREFIX original-space-flag) matches)) ) (setq no-section-matches (cons (list ent txt txt :NUMERIC_PREFIX nil) no-section-matches)) ; 整个文本作为编号 ) ) ;; 格式6: 复合前缀格式，如 2A-XL1 200x550 或 3B-KL2 300x600 ((and (wcmatch normalized-txt "*[0-9][A-Z]*-*L*[0-9]* *[0-9]*[*xX]?*[0-9]*") (vl-some '(lambda (prefix) (wcmatch normalized-txt (strcat "*[0-9][A-Z]*-" prefix "*[0-9]* *[0-9]*[*xX]?*[0-9]*"))) beam-prefixes)) (setq dash-pos (vl-string-position 45 normalized-txt)) ; 查找横杠位置 (setq space-pos (vl-string-position 32 normalized-txt (1+ dash-pos))) ; 查找空格位置 (if (and dash-pos space-pos) (progn (setq beam-number (substr txt 1 space-pos)) ; 提取到空格部分作为编号（包括前缀） (setq section-text (substr txt (1+ space-pos))) ; 提取空格后面的截面信息 (setq original-space-flag T) ; 明确标记有空格 (setq matches (cons (list ent txt beam-number section-text :COMPLEX_PREFIX original-space-flag) matches)) ) (setq no-section-matches (cons (list ent txt txt :COMPLEX_PREFIX nil) no-section-matches)) ; 整个文本作为编号 ) ) ;; 格式1: 带括号的梁编号+截面（无空格分隔），如 XL(1)200*750 或 LL(1A)300*600 ((and (wcmatch normalized-txt "*L*[0-9]*(*)*[0-9]*[*xX]?*[0-9]*") (vl-some '(lambda (prefix) (wcmatch normalized-txt (strcat "*" prefix "*[0-9]*(*)*[0-9]*[*xX]?*[0-9]*"))) beam-prefixes)) (setq right-bracket-pos (vl-string-position 41 normalized-txt)) ; 查找右括号位置 (if right-bracket-pos (progn (setq beam-number (substr txt 1 (1+ right-bracket-pos))) ; 提取到右括号部分作为编号（包括右括号） (setq section-text (substr txt (+ right-bracket-pos 2))) ; 提取右括号后面的截面信息（保持原样） ;; 检查原文本是否有空格 (setq original-space-flag (if (eq (substr txt (+ right-bracket-pos 1) 1) " ") T nil)) (setq matches (cons (list ent txt beam-number section-text :BRACKET_NO_SPACE original-space-flag) matches)) ) (setq matches (cons (list ent txt txt "" :BRACKET_ONLY nil) matches)) ; 如果没有右括号，整个作为编号 ) ) ;; 格式2: 带括号的梁编号+截面（有空格分隔），如 XL(1) 200*750 或 LL(1A) 300*600 ((and (wcmatch normalized-txt "*L*[0-9]*(*)* *[0-9]*[*xX]?*[0-9]*") (vl-some '(lambda (prefix) (wcmatch normalized-txt (strcat "*" prefix "*[0-9]*(*)* *[0-9]*[*xX]?*[0-9]*"))) beam-prefixes)) (setq space-pos (vl-string-position 32 normalized-txt)) ; 空格位置 (if space-pos (progn (setq right-bracket-pos (vl-string-position 41 normalized-txt)) ; 查找右括号位置 (if right-bracket-pos (progn (setq beam-number (substr txt 1 (1+ right-bracket-pos))) ; 提取到右括号部分作为编号（包括右括号） (setq section-text (substr txt (+ space-pos 1))) ; 提取空格后面的截面信息（保持原样） (setq original-space-flag T) ; 明确标记有空格 (setq matches (cons (list ent txt beam-number section-text :BRACKET_WITH_SPACE original-space-flag) matches)) ) (setq matches (cons (list ent txt txt "" :BRACKET_ONLY nil) matches)) ; 整个文本作为编号 ) ) (setq matches (cons (list ent txt txt "" :BRACKET_ONLY nil) matches)) ; 整个文本作为编号 ) ) ;; 格式3: 带括号的梁编号但没有截面信息，如 XL(1) 或 LL(1A) ((and (wcmatch normalized-txt "*L*[0-9]*(*)*") (vl-some '(lambda (prefix) (wcmatch normalized-txt (strcat "*" prefix "*[0-9]*(*)*"))) beam-prefixes)) (setq no-section-matches (cons (list ent txt txt :BRACKET_ONLY nil) no-section-matches)) ) ;; 格式4: 不带括号的梁编号+截面（无空格分隔），如 XL200*750 或 LL300*600 ((and (wcmatch normalized-txt "*L*[0-9]*[0-9]*[*xX]?*[0-9]*") (vl-some '(lambda (prefix) (wcmatch normalized-txt (strcat "*" prefix "*[0-9]*[0-9]*[*xX]?*[0-9]*"))) beam-prefixes)) (setq pos (vl-string-search "*" normalized-txt)) ; 查找乘号位置 (if (not pos) (setq pos (vl-string-search "x" normalized-txt))) (if (not pos) (setq pos (vl-string-search "X" normalized-txt))) (if pos (progn (setq beam-number "") (setq j 0) (while (and (< j (strlen txt)) (not (digit-char-p (substr txt (1+ j) 1)))) ; 使用自定义的 digit-char-p (setq beam-number (strcat beam-number (substr txt (1+ j) 1))) (setq j (1+ j)) ) (setq section-text (substr txt (1+ j))) ; 保持原样提取 ;; 检查原文本是否有空格 (setq original-space-flag (if (eq (substr txt (1+ j) 1) " ") T nil)) (setq matches (cons (list ent txt beam-number section-text :NO_BRACKET_NO_SPACE original-space-flag) matches)) ) (setq no-section-matches (cons (list ent txt txt :NO_BRACKET_ONLY nil) no-section-matches)) ) ) ;; 格式5: 不带括号的梁编号但没有截面信息，如 XL 或 LL2 ((and (wcmatch normalized-txt "*L*[0-9]*") (vl-some '(lambda (prefix) (wcmatch normalized-txt (strcat "*" prefix "*[0-9]*"))) beam-prefixes)) (setq no-section-matches (cons (list ent txt txt :NO_BRACKET_ONLY nil) no-section-matches)) ) ) (setq i (1+ i)) ) ;; 第二步：检测冲突的梁编号（相同编号不同截面） (setq conflict-beams (detect-conflicts matches)) ;; 第三步：检测跨数冲突的梁编号（相同基础编号不同跨数） ;; 修改点：只使用 matches 列表中的项进行跨数冲突检测 (setq span-conflict-beams (detect-span-conflicts (append matches no-section-matches))) ;; 第四步：标记所有冲突的原始文本 和 目标文本 (if (eq mark-option "Y") (progn ;; 标记截面冲突（黄色圆圈） (if conflict-beams (progn (foreach cb conflict-beams (setq beam-number (car cb)) (setq sections (cadr cb)) ;; 标记所有匹配该梁编号的原始文本 (foreach m matches (if (equal (strcase (caddr m)) (strcase beam-number)) (mark-conflict-text (car m) conflict-layer conflict-color) ) ) ;; 新增：标记所有匹配该梁编号的目标文本（未加截面信息的） (foreach nsm no-section-matches (if (equal (strcase (caddr nsm)) (strcase beam-number)) (mark-conflict-text (car nsm) conflict-layer conflict-color) ) ) ) (alert (strcat "发现 " (itoa (length conflict-beams)) " 处相同编号不同截面尺寸的冲突（黄色圆圈标注） 请检查这些梁是否有误: " (apply 'strcat (mapcar '(lambda (x) (strcat (car x) ": " (vl-princ-to-string (cadr x)) " ")) conflict-beams)))) ) ) ;; 标记跨数冲突（粉色圆圈） (if span-conflict-beams (progn (foreach scb span-conflict-beams (setq base-beam-name (car scb)) (setq span-numbers (cadr scb)) ;; 标记所有匹配该梁编号的原始文本（包括带截面和不带截面的） (foreach m (append matches no-section-matches) (setq current-beam (if (eq (length m) 4) (caddr m) (caddr m))) ; 处理两种格式的匹配项 (if (wcmatch (strcase current-beam) (strcat (strcase base-beam-name) "(*)*")) (mark-span-conflict-text (car m) span-conflict-layer span-conflict-color) ) ) ) (alert (strcat "发现 " (itoa (length span-conflict-beams)) " 处相同编号不同跨数的冲突（粉色圆圈标注） 请检查这些梁是否有误: " (apply 'strcat (mapcar '(lambda (x) (strcat (car x) ": 跨数" (vl-princ-to-string (cadr x)) " ")) span-conflict-beams)))) ) ) ) ) ;; 第五步：处理只有编号的文本（跳过有冲突的梁编号） (if no-section-matches (progn (setq final-ss (ssadd)) ; 最终选择集 (setq processed-count 0) ; 处理计数器 (setq conflict-count (length conflict-beams)) ; 冲突计数器 (setq span-conflict-count (length span-conflict-beams)) ; 跨数冲突计数器 (foreach no-section no-section-matches (setq ent (car no-section)) (setq txt (cadr no-section)) (setq txt-format (cadddr no-section)) ; 获取原始文本的格式类型 (setq normalized-beam (strcase txt)) ; 转换为大写便于比较 (setq found-sections '()) ; 存储找到的所有截面信息 (setq found-formats '()) ; 存储找到的截面格式类型 (setq found-space-flags '()) ; 存储找到的截面是否有空格 ;; 提取基础梁编号（根据格式类型） (setq current-beam-number txt) (cond ;; 处理标准格式（如LL1） ((eq txt-format :STANDARD_FORMAT) (setq space-pos (vl-string-position 32 normalized-beam)) ; 查找空格位置 (if space-pos (setq current-beam-number (substr txt 1 space-pos)) ) ) ;; 处理数字前缀格式（如4KL14） ((eq txt-format :NUMERIC_PREFIX) (setq space-pos (vl-string-position 32 normalized-beam)) ; 查找空格位置 (if space-pos (setq current-beam-number (substr txt 1 space-pos)) ) ) ;; 处理复合前缀格式（如2A-XL1） ((eq txt-format :COMPLEX_PREFIX) (setq dash-pos (vl-string-position 45 normalized-beam)) ; 查找横杠位置 (setq space-pos (vl-string-position 32 normalized-beam)) ; 查找空格位置 (if dash-pos (setq current-beam-number (if space-pos (substr txt 1 space-pos) txt)) ) ) ;; 处理带括号格式 ((eq txt-format :BRACKET_ONLY) (setq bracket-pos (vl-string-position 40 normalized-beam)) ; 查找左括号位置 (if bracket-pos (progn (setq right-bracket-pos (vl-string-position 41 normalized-beam)) ; 查找右括号位置 (if right-bracket-pos (setq current-beam-number (substr txt 1 (1+ right-bracket-pos))) ; 包括右括号 ) ) ) ) ) ;; 检查当前梁编号是否有冲突（截面或跨数） ;; 修改点：对于带括号的编号，需要检查其基础部分是否在跨数冲突列表中 (setq is-conflict nil) ;; 首先检查是否在截面冲突列表中 (if (vl-some '(lambda (cb) (equal (strcase current-beam-number) (strcase (car cb)))) conflict-beams) (setq is-conflict T) ) ;; 然后检查是否在跨数冲突列表中 (if (not is-conflict) (progn (cond ;; 如果是带括号的格式，提取基础编号（括号前的部分）进行检查 ((eq txt-format :BRACKET_ONLY) (setq bracket-pos (vl-string-position 40 normalized-beam)) (if bracket-pos (progn (setq base-name (substr txt 1 bracket-pos)) (if (vl-some '(lambda (scb) (equal (strcase base-name) (strcase (car scb)))) span-conflict-beams) (setq is-conflict T) ) ) ) ) ;; 对于其他格式，检查完整编号是否匹配跨数冲突的基础编号 (t (if (vl-some '(lambda (scb) (wcmatch (strcase current-beam-number) (strcat "*" (strcase (car scb)) "*"))) span-conflict-beams) (setq is-conflict T) ) ) ) ) ) (if is-conflict (progn ;; 跳过冲突的梁编号 nil ) (progn ;; 遍历所有文本寻找匹配项（包括带截面的） (foreach m matches (setq m-txt (cadr m)) (setq m-beam-number (caddr m)) (setq m-section-text (cadddr m)) (setq m-format (car (cddddr m))) ; 获取匹配文本的格式类型 (setq m-space-flag (nth 5 m)) ; 获取匹配文本的空格标志 ;; 精确匹配逻辑（必须完全相同的梁编号，包括后缀数字） (if (equal (strcase current-beam-number) (strcase m-beam-number)) (progn (if (and (not (equal m-section-text "")) (not (member m-section-text found-sections))) (progn (setq found-sections (cons m-section-text found-sections)) (setq found-formats (cons m-format found-formats)) (setq found-space-flags (cons m-space-flag found-space-flags)) ) ) ) ) ) ;; 更新文本内容（使用找到的第一个有效截面） (if found-sections (progn ;; 根据原始文本格式和匹配到的截面格式决定如何连接 (setq new-txt (cond ;; 原始文本是标准格式 ((eq txt-format :STANDARD_FORMAT) (if (car found-space-flags) ; 如果匹配的文本有空格 (strcat (vl-string-trim " " txt) " " (vl-string-trim " " (car found-sections))) (strcat txt (car found-sections)) ) ) ;; 原始文本是数字前缀格式 ((eq txt-format :NUMERIC_PREFIX) (if (car found-space-flags) ; 如果匹配的文本有空格 (strcat (vl-string-trim " " txt) " " (vl-string-trim " " (car found-sections))) (strcat txt (car found-sections)) ) ) ;; 原始文本是复合前缀格式 ((eq txt-format :COMPLEX_PREFIX) (if (car found-space-flags) ; 如果匹配的文本有空格 (strcat (vl-string-trim " " txt) " " (vl-string-trim " " (car found-sections))) (strcat txt (car found-sections)) ) ) ;; 原始文本是带括号格式 ((or (eq txt-format :BRACKET_ONLY) (eq txt-format :BRACKET_WITH_SPACE)) (if (car found-space-flags) ; 如果匹配的文本有空格 (strcat (vl-string-trim " " txt) " " (vl-string-trim " " (car found-sections))) (strcat txt (car found-sections)) ) ) ;; 原始文本是无括号格式 ((or (eq txt-format :NO_BRACKET_ONLY) (eq txt-format :NO_BRACKET_WITH_SPACE)) (if (car found-space-flags) ; 如果匹配的文本有空格 (strcat (vl-string-trim " " txt) " " (vl-string-trim " " (car found-sections))) (strcat txt (car found-sections)) ) ) ;; 默认情况 (t (strcat txt (car found-sections))) ) ) (setq ent-data (entget ent)) ;; 修改文本内容 (entmod (subst (cons 1 new-txt) (assoc 1 ent-data) ent-data)) (setq ent-data (entget ent)) ; 重新获取修改后的实体数据 (ssadd ent final-ss) (setq processed-count (1+ processed-count)) ;; 如果需要添加红色圆圈标注 (if (eq mark-option "Y") (mark-matched-text ent-data circle-layer circle-color) ) ) ) ) ) ) ;; 结果反馈 (cond ((> processed-count 0) (sssetfirst nil final-ss) (princ (strcat " 操作完成: 成功为 " (itoa processed-count) " 根梁添加了截面信息")) (if (eq mark-option "Y") (princ "，并添加了红色标注圆圈") ) ) ((> conflict-count 0) (princ (strcat " 警告: 发现 " (itoa conflict-count) " 处相同梁编号但不同截面的冲突")) (if (eq mark-option "Y") (princ "，已用黄色圆圈标注原文本与目标文本") ) ) ((> span-conflict-count 0) (princ (strcat " 警告: 发现 " (itoa span-conflict-count) " 处相同基础编号但不同跨数的冲突")) (if (eq mark-option "Y") (princ "，已用粉色圆圈标注原始文本") ) ) ((> (length no-section-matches) 0) (princ " 警告: 未找到匹配的截面信息") ) (t (princ " 提示: 未找到需要处理的梁编号文本") ) ) ) (princ " 提示: 未找到需要处理的梁编号文本") ) ) (princ " 取消: 未选择任何文本") ) ;; --- 新增：在最后创建冲突信息表格（使用MTEXT），并让用户点击确认位置 --- (if (or conflict-beams span-conflict-beams) (progn ;; 提示用户选择插入点 (princ " 请在图形中点击鼠标左键，以确定冲突信息表格的放置位置...") (setq table-insert-point (getpoint " 指定表格插入点: ")) ;; 如果用户指定了点，则创建表格 (if table-insert-point (progn ;; 初始化表格文本内容 (setq conflict-table-text "{\\f宋体|b1|i0|c0|p34;\\C7;冲突信息汇总表\\P}") ;; 添加截面冲突信息 (if conflict-beams (progn (setq conflict-table-text (strcat conflict-table-text "{\\f宋体|b0|i0|c0|p34;【截面冲突】\\P}")) (foreach cb conflict-beams (setq conflict-table-text (strcat conflict-table-text "{\\f宋体|b0|i0|c0|p34;梁编号: " (car cb) "\\P}" "{\\f宋体|b0|i0|c0|p34;冲突截面: " (vl-princ-to-string (cadr cb)) "\\P}" "{\\f宋体|b0|i0|c0|p34;------------------------------\\P}" ) ) ) ) (setq conflict-table-text (strcat conflict-table-text "{\\f宋体|b0|i0|c0|p34;【截面冲突】\\P}{\\f宋体|b0|i0|c0|p34;无截面冲突\\P}")) ) ;; 添加跨数冲突信息 (if span-conflict-beams (progn (setq conflict-table-text (strcat conflict-table-text "{\\f宋体|b0|i0|c0|p34;【跨数冲突】\\P}")) (foreach scb span-conflict-beams (setq conflict-table-text (strcat conflict-table-text "{\\f宋体|b0|i0|c0|p34;基础梁编号: " (car scb) "\\P}" "{\\f宋体|b0|i0|c0|p34;冲突跨数/前缀: " (vl-princ-to-string (cadr scb)) "\\P}" "{\\f宋体|b0|i0|c0|p34;------------------------------\\P}" ) ) ) ) (setq conflict-table-text (strcat conflict-table-text "{\\f宋体|b0|i0|c0|p34;【跨数冲突】\\P}{\\f宋体|b0|i0|c0|p34;无跨数冲突\\P}")) ) ;; 使用 entmake 创建 MTEXT 实体 (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 10 table-insert-point) ; 插入点 (由用户指定) (cons 40 3.5) ; 文字高度 (cons 41 0) ; 列宽 (0 = 自动换行) (cons 71 1) ; 附着点 (1 = 左上) (cons 72 5) ; 绘图方向 (5 = 由左至右) (cons 1 conflict-table-text) ; MTEXT 内容 '(7 . "Standard") ; 文字样式 ) ) (princ " 冲突信息表格已创建。") ) (princ " 操作取消，未创建冲突信息表格。") ) ) ) ;; --- 新增结束 --- (setvar "cmdecho" 1) (setvar "osmode" old-osmode) (princ) ) ;; 检测冲突的梁编号（相同编号不同截面） (defun detect-conflicts (matches / beam-table conflicts) (setq beam-table '()) (setq conflicts '()) ;; 构建梁编号到截面的映射表 (foreach m matches (setq beam-number (caddr m)) (setq section-text (cadddr m)) (if (not (equal section-text "")) (progn (setq existing-entry (assoc beam-number beam-table)) (if existing-entry (progn ;; 检查截面是否不同 (if (not (member section-text (cdr existing-entry))) (progn ;; 添加到冲突列表 (if (not (member beam-number conflicts)) (setq conflicts (cons beam-number conflicts)) ) ;; 更新映射表 (setq beam-table (subst (cons beam-number (cons section-text (cdr existing-entry))) existing-entry beam-table)) ) ) ) (setq beam-table (cons (cons beam-number (list section-text)) beam-table)) ) ) ) ) ;; 返回冲突列表（每个冲突项包含梁编号和所有不同截面） (setq result '()) (foreach cb conflicts (setq sections (cdr (assoc cb beam-table))) (setq result (cons (list cb sections) result)) ) result ) ;; 检测跨数冲突的梁编号（相同基础编号不同跨数） (defun detect-span-conflicts (all-matches / beam-table conflicts) (setq beam-table '()) (setq conflicts '()) ;; 处理所有匹配项（包括带截面和不带截面的） (foreach m all-matches (setq beam-number (caddr m)) (setq normalized-beam (strcase beam-number)) (cond ;; 处理标准格式（如LL1） ((and (wcmatch normalized-beam "*L*[0-9]*") (not (wcmatch normalized-beam "*[0-9][A-Z]*-*")) (not (wcmatch normalized-beam "*[*xX]*")) (not (wcmatch normalized-beam "*(*)*"))) (setq space-pos (vl-string-position 32 normalized-beam)) ; 查找空格位置 (setq base-beam-name "") ;; 提取基础梁编号（前缀+数字部分） (setq j 0) (while (and (< j (strlen beam-number)) (or (not (digit-char-p (substr beam-number (1+ j) 1))) (and (> j 0) (digit-char-p (substr beam-number (1+ j) 1))))) (setq base-beam-name (strcat base-beam-name (substr beam-number (1+ j) 1))) (setq j (1+ j)) ) (if space-pos (setq base-beam-name (substr beam-number 1 space-pos)) ) ;; 添加到映射表（使用基础编号作为键） (setq existing-entry (assoc base-beam-name beam-table)) (if existing-entry (progn ;; 检查完整编号是否不同 (if (not (member beam-number (cdr existing-entry))) (progn ;; 添加到冲突列表 (if (not (member base-beam-name conflicts)) (setq conflicts (cons base-beam-name conflicts)) ) ;; 更新映射表 (setq beam-table (subst (cons base-beam-name (cons beam-number (cdr existing-entry))) existing-entry beam-table)) ) ) ) (setq beam-table (cons (cons base-beam-name (list beam-number)) beam-table)) ) ) ;; 处理数字前缀格式（如4KL14）--- 重要修改 --- ;; 修改逻辑：将整个带数字前缀的编号视为一个独立且完整的实体，不进行任何拆分。 ;; 这样，4KL14 和 5KL14 就是两个不同的梁，不会被判定为跨数冲突。 ((wcmatch normalized-beam "[0-9]*L*[0-9]*") ;; 不做任何特殊处理，直接跳过。 ;; 此分支留空。 ) ;; 处理复合前缀格式（如2A-XL1） ((wcmatch normalized-beam "*[0-9][A-Z]*-*L*[0-9]*") (setq dash-pos (vl-string-position 45 normalized-beam)) ; 查找横杠位置 (if dash-pos (progn ;; 提取基础梁编号（横杠后的部分） (setq base-beam-name (substr beam-number (1+ dash-pos))) ;; 提取前缀编号（横杠前的部分） (setq prefix-number (substr beam-number 1 dash-pos)) ;; 添加到映射表（使用基础编号作为键） (setq existing-entry (assoc base-beam-name beam-table)) (if existing-entry (progn ;; 检查前缀是否不同 (if (not (member prefix-number (cdr existing-entry))) (progn ;; 添加到冲突列表 (if (not (member base-beam-name conflicts)) (setq conflicts (cons base-beam-name conflicts)) ) ;; 更新映射表 (setq beam-table (subst (cons base-beam-name (cons prefix-number (cdr existing-entry))) existing-entry beam-table)) ) ) ) (setq beam-table (cons (cons base-beam-name (list prefix-number)) beam-table)) ) ) ) ) ;; 处理带括号格式（如 KL7(3A)） ((wcmatch normalized-beam "*L*[0-9]*(*)*") (setq left-bracket-pos (vl-string-position 40 normalized-beam)) ; 查找左括号位置 (if left-bracket-pos (progn (setq right-bracket-pos (vl-string-position 41 normalized-beam)) ; 查找右括号位置 (if (and right-bracket-pos (> right-bracket-pos left-bracket-pos)) (progn ;; 提取基础梁编号（括号前的部分） (setq base-beam-name (substr beam-number 1 left-bracket-pos)) ;; 提取跨数（括号内的内容） (setq span-number (substr beam-number (+ left-bracket-pos 2) (- right-bracket-pos left-bracket-pos 1))) ;; 添加到映射表 (setq existing-entry (assoc base-beam-name beam-table)) (if existing-entry (progn ;; 检查跨数是否不同 (if (not (member span-number (cdr existing-entry))) (progn ;; 添加到冲突列表 (if (not (member base-beam-name conflicts)) (setq conflicts (cons base-beam-name conflicts)) ) ;; 更新映射表 (setq beam-table (subst (cons base-beam-name (cons span-number (cdr existing-entry))) existing-entry beam-table)) ) ) ) (setq beam-table (cons (cons base-beam-name (list span-number)) beam-table)) ) ) ) ) ) ) ) ) ;; 返回冲突列表（每个冲突项包含基础梁编号和所有不同前缀/跨数） (setq result '()) (foreach cb conflicts (setq spans (cdr (assoc cb beam-table))) (setq result (cons (list cb spans) result)) ) result ) ;; 标记匹配的文本（添加红色圆圈） (defun mark-matched-text (ent-data layer color / text-pt text-height text-rotation text-box text-width text-height-adjusted circle-center circle-radius) ;; 获取文本属性 (setq text-pt (cdr (assoc 10 ent-data))) ; 文本插入点 (setq text-height (cdr (assoc 40 ent-data))) ; 文字高度 (setq text-rotation (cdr (assoc 50 ent-data))) ; 文字旋转角度 ;; 计算完整文本的包围框（包含编号和截面） (setq text-box (textbox ent-data)) ; 获取完整文本包围框坐标 (setq text-width (- (car (cadr text-box)) (car (car text-box)))) ; 计算完整文本宽度 (setq text-height-adjusted (* text-height 1.5)) ; 调整高度系数 ;; 计算圆心坐标（位于完整文本中心） (setq circle-center (polar text-pt text-rotation (/ text-width 2))) ; 移动到完整文本中心 ;; 设置动态半径（基于完整文本实际尺寸） (setq circle-radius (* (sqrt (+ (expt (/ text-width 2) 2) (expt (/ text-height-adjusted 2) 2))) 1.1) ; 增加10%的边距 ) ; 计算对角线长度作为半径 ;; 创建红色圆圈 (entmake (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") (cons 8 layer) (cons 10 circle-center) (cons 40 circle-radius) (cons 62 color))) ) ;; 标记冲突文本（添加黄色圆圈） (defun mark-conflict-text (ent layer color / ent-data text-pt text-height text-rotation text-box text-width text-height-adjusted circle-center circle-radius) (setq ent-data (entget ent)) ;; 获取文本属性 (setq text-pt (cdr (assoc 10 ent-data))) ; 文本插入点 (setq text-height (cdr (assoc 40 ent-data))) ; 文字高度 (setq text-rotation (cdr (assoc 50 ent-data))) ; 文字旋转角度 ;; 计算完整文本的包围框 (setq text-box (textbox ent-data)) ; 获取完整文本包围框坐标 (setq text-width (- (car (cadr text-box)) (car (car text-box)))) ; 计算完整文本宽度 (setq text-height-adjusted (* text-height 1.5)) ; 调整高度系数 ;; 计算圆心坐标（位于完整文本中心） (setq circle-center (polar text-pt text-rotation (/ text-width 2))) ; 移动到完整文本中心 ;; 设置动态半径（基于完整文本实际尺寸） (setq circle-radius (* (sqrt (+ (expt (/ text-width 2) 2) (expt (/ text-height-adjusted 2) 2))) 1.1) ; 增加10%的边距 ) ; 计算对角线长度作为半径 ;; 创建黄色圆圈 (entmake (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") (cons 8 layer) (cons 10 circle-center) (cons 40 circle-radius) (cons 62 color))) ) ;; 标记跨数冲突文本（添加粉色圆圈） (defun mark-span-conflict-text (ent layer color / ent-data text-pt text-height text-rotation text-box text-width text-height-adjusted circle-center circle-radius) (setq ent-data (entget ent)) ;; 获取文本属性 (setq text-pt (cdr (assoc 10 ent-data))) ; 文本插入点 (setq text-height (cdr (assoc 40 ent-data))) ; 文字高度 (setq text-rotation (cdr (assoc 50 ent-data))) ; 文字旋转角度 ;; 计算完整文本的包围框 (setq text-box (textbox ent-data)) ; 获取完整文本包围框坐标 (setq text-width (- (car (cadr text-box)) (car (car text-box)))) ; 计算完整文本宽度 (setq text-height-adjusted (* text-height 1.5)) ; 调整高度系数 ;; 计算圆心坐标（位于完整文本中心） (setq circle-center (polar text-pt text-rotation (/ text-width 2))) ; 移动到完整文本中心 ;; 设置动态半径（基于完整文本实际尺寸） (setq circle-radius (* (sqrt (+ (expt (/ text-width 2) 2) (expt (/ text-height-adjusted 2) 2))) 1.1) ; 增加10%的边距 ) ; 计算对角线长度作为半径 ;; 创建粉色圆圈（洋红色索引号为6） (entmake (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") (cons 8 layer) (cons 10 circle-center) (cons 40 circle-radius) (cons 62 color))) ) ;; 加载提示 (princ " 梁截面匹配程序已加载，输入 LJM 命令运行。") (princ) 请帮我检查此代码在识别判断各种类型的编号或者截面匹配是否正确，有没有需要改进的地方，确保能正确识别判断匹配截面，请给出你修改后的完整代码
最新发布
09-11
我们正在处理一个AutoLISP代码问题，用户希望检查代码中关于编号和截面匹配识别的正确性，并进行改进。由于用户没有提供具体的代码，我们需要假设一个典型的场景：在AutoCAD中，AutoLISP程序用于处理结构构件（如梁...
【战役总结】Common Lisp : A Gentle Introduction to Symbolic Computation
u010665051的专栏
08-17 2321
一.内容简介      整本书一共分成了14章，介绍了Common Lisp编程的入门级内容，虽然如此，整本书所介绍的内容是非常生动有趣的，且动手的练习也很多，每章都有Keyboard Exercise——就是那种需要你动手按照说明编写代码的大练习，比较有趣的几个键盘练习有：掷骰子游戏（第五章）、一个简单知识系统的模式匹配器（第七章）、家谱数据库（第八章）、一元函数画图程序（第九章）、经典的TI
csapp-深入理解计算机系统学习记录
热门推荐
mackilo的博客
02-16 1万+
文章目录csapp 学习记录一第1章：计算机系统漫游信息就是位+上下文从一个c文件，到可执行目标文件整个翻译过程分为4个阶段程序执行的过程：摩尔定律：HELLO WORLD 可执行程序的产生理解编译过程及原理的意义何在可执行程序hello在计算机上执行的过程程序执行过程中的几点启示系统的硬件组成高速缓存存储设备形成层次结构操作系统管理硬件进程线程虚拟内存并发和并行线程级并发指令级并行第2章：信息表示和处理2.1 信息存储2.1.1 十六进制表示法2.1.2 字2.1.3 数据大小2.1.4 寻址和字节顺序2
Lua判断变量是否为数字、字符串是否可以转换为数字等
09-22
主要介绍了Lua判断变量是否为数字、字符串是否可以转换为数字等,本文讲解了Lua 判断是字符还是数字的方法、Lua判断数字的方法、判断可否转换为数字的方法、判断并且准备一个初值的方法,需要的朋友可以参考下
LISP Examples
06-09
极为难得的common lisp语言的程序示例，值得借鉴参考。相关资源极少。
trivial-formatter:常见Lisp的代码格式化程序
05-24
试用格式9.0.0 这是什么？ 常见Lisp的代码格式化程序。 请参阅。 该文件由琐碎格式化程序本身格式化。 用法 (trivial-formatter:fmt :your-system :supersede) 有关详细信息，请参见。 行宽。 默认值取决于实现。 （虽然可能是80。）您可以使用普通的lisp漂亮打印系统方式来控制它，即使用*PRINT-RIGHT-MARGIN* 。 ( let (( *print-right-margin* 100 )) ; <-- Specify line width with 100. (trivial-formatter:fmt :your-system :supersede)) 严格模式。 当您调用调试器时，某些实现（例如ECL）已包含在：cl-user软件包中。 在这种情况下， LOOP宏回溯形式变得难看。 ( LOOP YOUR
JZ54---字符流中第一个不重复的字符
Eva_xiaoxi的博客
09-09 880
题目 请实现一个函数用来找出字符流中第一个只出现一次的字符。例如，当从字符流中只读出前两个字符"go"时，第一个只出现一次的字符是"g"。当从该字符流中读出前六个字符“google"时，第一个只出现一次的字符是"l"。 输出描述 如果当前字符流没有存在出现一次的字符，返回#字符。 思路 使用LinkedHashMap 链接输入的所有值。它的优点在于，不会自动排序，你是好久进入的map集合，它就在最后面追加上。如果出现以前重复的值，修改的位置就在以前那个位置 遍历map集合，找到第一个值为1的那个字
279_common lisp Format小结
小灰笔记
02-26 957
完整的emacs and lisp的学习集合整理如下： https://github.com/GreyZhang/g_lisp 继续学习emacs，继续学习lisp。这一次小结一下common lisp中的format。 上面是一个加单的小例子，format函数传入了两个参数。第一个参数，指定的是输出的stream，第二个参数是输出信息。这里，输出的stream是nil，...
lisp 利器 format 语法示例 控制字符
cudi7618的博客
01-07 574
lisp 里的format 是输出的利器，不亚于c 语言的printf（） 我们主要展示 控制字符的行为： 注意 ~s 是输出 “” 的 ~a 是不输出的。~10s ~10a 指定宽带，空格后置 ~...
判断某个字符串是否是数字(简单方法)
weixin_30788731的博客
07-13 137
//---------------------------------function isNumber(str){var strtemp="0123456789";var i;//循环变量var flag=true;for (i=0;i<str.length;i++){if (strtemp.indexOf(str.charAt(i))<0)...
数字计算lisp_可从计算尺和LISP中汲取教训
weixin_26644585的博客
09-23 216
数字计算lispSat around a wooden table, with brown cloth upholstered chairs I remember watching my father work on the family company’s tax returns. 我坐在一张木桌旁，摆着棕色布软垫椅子，我记得我看着父亲在家族公司的纳税申报表上工作。 In the backgr...
Autolisp 框选图形，统计各类图形的数量，输出到文件。
qq_26945795的博客
07-21 1868
本文的目的是为了统计CAD中三种类型元素出现的次数，并输出成一个txt文件。先看整体要达到的效果。 (defun c:mm() (setq ss (ssget)) (setq n 0) (setq n_cir 0 n_line 0 n_arc 0) (repeat (sslength ss) (setq en (ssname ss n)) (setq endata(entget en)) (setq entype (cdr (assoc 0 endata)))
Lisp语言-format t语句的使用与输出技巧
资源摘要信息:"lisp代码-format t 输出语句" 在Lisp语言中，`format`函数是用于格式化输出的通用接口。它不仅可以用来打印文本，还能处理数字和其他数据类型的格式化输出。`format t`是`format`函数的一个常见用法...
评论
成就一亿技术人!
拼手气红包6.0元
还能输入1000个字符
 
红包 添加红包
表情包 插入表情
表情包 代码片
 条评论被折叠 查看
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

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

抵扣说明：

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

余额充值