多重引线标注改文字和直线的距离

woshilj

没有学过编程，之前一直在这里当伸手党，最近deepseek比较火热，于是也用来写了一个小插件，写完也调试了很多遍，最后终于能跑了，当然代码写的不够好看，主打一个能跑就行。现在直接分享源码，看看大佬们有空的话优化一下更美观。

2. (defun c:CML (/ ss idx mleader entData textContent newContent obj)
   
3.   ;; 选择多重引线
   
4.   (prompt "\n选择多重引线: ")
   
5.   (setq ss (ssget '((0 . "MULTILEADER"))))
   
6.   (if ss
   
7.     (progn
   
8.       (setq idx 0)
   
9.       (while (< idx (sslength ss))
   
10.         (setq mleader (ssname ss idx))
    
11.         (setq entData (entget mleader))
    
12.         ;; 获取多重引线内的多行文字内容（组码 304）
    
13.         (setq textContent (cdr (assoc 304 entData)))
    
14.         
    
15.         ;; 清除所有以 \p 开始、以 ; 结尾的格式代码（排除 \\p 的情况）
    
16.         (setq textContent (remove-p-format-codes textContent))
    
17.         
    
18.         ;; 在文字最前面添加 \pxse1.2;
    
19.         (setq newContent (strcat "\\pxse1.2;" textContent))
    
20.         
    
21.         ;; 在 \P 分隔符后添加行距参数
    
22.         (setq newContent (add-line-spacing newContent))
    
23.         
    
24.         ;; 更新多重引线的多行文字内容
    
25.         (setq entData (subst (cons 304 newContent) (assoc 304 entData) entData))
    
26.         (entmod entData)
    
27.         (entupd mleader)
    
28.         
    
29.         ;; 获取多重引线的 ActiveX 对象
    
30.         (setq obj (vlax-ename->vla-object mleader))
    
31.         
    
32.         ;; 设置连接位置 - 左为第一行加下划线
    
33.         (vlax-put obj 'TextLeftAttachmentType 3)
    
34.         
    
35.         ;; 设置连接位置 - 右为第一行加下划线
    
36.         (vlax-put obj 'TextRightAttachmentType 3)
    
37.         
    
38.         ;; 设置箭头样式为无
    
39.         (vlax-put obj 'ArrowheadType 19)
    
40.         
    
41.         ;; 设置基线距离为 0.5
    
42.         (vlax-put obj 'DoglegLength 0.5)
    
43.         
    
44.         (setq idx (1+ idx))
    
45.       )
    
46.       (prompt "\n多重引线内多行文字段落行距修改完成，并设置连接位置为第一行加下划线，箭头样式为无，基线距离为 0.5。")
    
47.     )
    
48.     (prompt "\n未选择到多重引线。")
    
49.   )
    
50.   (princ)
    
51. )
    
52. 
    
53. ;; 辅助函数：清除所有以 \p 开始、以 ; 结尾的格式代码（排除 \\p 的情况）
    
54. (defun remove-p-format-codes (text / pos1 pos2)
    
55.   (setq pos1 0)
    
56.   (while (setq pos1 (vl-string-search "\\p" text pos1))
    
57.     ;; 检查 \p 前面是否有 \ 符号
    
58.     (if (and (> pos1 0) (eq (substr text pos1 1) "\"))
    
59.       (setq pos1 (+ pos1 2)) ;; 排除 \\p，继续查找下一个 \p
    
60.       (progn
    
61.         ;; 查找分号 ;
    
62.         (setq pos2 (vl-string-search ";" text pos1))
    
63.         (if pos2
    
64.           (progn
    
65.             ;; 删除 \p 到 ; 的内容
    
66.             (setq text (strcat (substr text 1 pos1) (substr text (+ pos2 2))))
    
67.             (setq pos1 0) ;; 重新开始查找
    
68.           )
    
69.           (setq pos1 (strlen text)) ;; 如果没有分号，结束查找
    
70.         )
    
71.       )
    
72.     )
    
73.   )
    
74.   text
    
75. )
    
76. 
    
77. ;; 辅助函数：在 \P 分隔符后添加行距参数
    
78. (defun add-line-spacing (text / pos1 pos2)
    
79.   ;; 查找第一个 \P 的位置
    
80.   (setq pos1 (vl-string-search "\\P" text))
    
81.   (if pos1
    
82.     (progn
    
83.       ;; 在第一个 \P 后添加 \pxse0.25;
    
84.       (setq text (strcat (substr text 1 (+ pos1 2)) "\\pxse0.25;" (substr text (+ pos1 3))))
    
85.       
    
86.       ;; 查找第二个 \P 的位置
    
87.       (setq pos2 (vl-string-search "\\P" text (+ pos1 3)))
    
88.       (if pos2
    
89.         ;; 在第二个 \P 后添加 \psm0.6;
    
90.         (setq text (strcat (substr text 1 (+ pos2 2)) "\\psm0.6;" (substr text (+ pos2 3))))
    
91.       )
    
92.     )
    
93.   )
    
94.   text
    
95. )
    

(defun c:CML (/ ss idx mleader entData textContent newContent obj)<br />   ;; 选择多重引线<br />   (prompt "\n选择多重引线: ")<br />   (setq ss (ssget '((0 . "MULTILEADER"))))<br />   (if ss<br />     (progn<br />       (setq idx 0)<br />       (while (< idx (sslength ss))<br />         (setq mleader (ssname ss idx))<br />         (setq entData (entget mleader))<br />         ;; 获取多重引线内的多行文字内容（组码 304）<br />         (setq textContent (cdr (assoc 304 entData)))<br />         <br />         ;; 清除所有以 \p 开始、以 ; 结尾的格式代码（排除 \\p 的情况）<br />         (setq textContent (remove-p-format-codes textContent))<br />         <br />         ;; 在文字最前面添加 \pxse1.2;<br />         (setq newContent (strcat "\\pxse1.2;" textContent))<br />         <br />         ;; 在 \P 分隔符后添加行距参数<br />         (setq newContent (add-line-spacing newContent))<br />         <br />         ;; 更新多重引线的多行文字内容<br />         (setq entData (subst (cons 304 newContent) (assoc 304 entData) entData))<br />         (entmod entData)<br />         (entupd mleader)<br />         <br />         ;; 获取多重引线的 ActiveX 对象<br />         (setq obj (vlax-ename->vla-object mleader))<br />         <br />         ;; 设置连接位置 - 左为第一行加下划线<br />         (vlax-put obj 'TextLeftAttachmentType 3)<br />         <br />         ;; 设置连接位置 - 右为第一行加下划线<br />         (vlax-put obj 'TextRightAttachmentType 3)<br />         <br />         ;; 设置箭头样式为无<br />         (vlax-put obj 'ArrowheadType 19)<br />         <br />         ;; 设置基线距离为 0.5<br />         (vlax-put obj 'DoglegLength 0.5)<br />         <br />         (setq idx (1+ idx))<br />       )<br />       (prompt "\n多重引线内多行文字段落行距修改完成，并设置连接位置为第一行加下划线，箭头样式为无，基线距离为 0.5。")<br />     )<br />     (prompt "\n未选择到多重引线。")<br />   )<br />   (princ)<br /> )<br /> <br /> ;; 辅助函数：清除所有以 \p 开始、以 ; 结尾的格式代码（排除 \\p 的情况）<br /> (defun remove-p-format-codes (text / pos1 pos2)<br />   (setq pos1 0)<br />   (while (setq pos1 (vl-string-search "\\p" text pos1))<br />     ;; 检查 \p 前面是否有 \ 符号<br />     (if (and (> pos1 0) (eq (substr text pos1 1) "\"))<br />       (setq pos1 (+ pos1 2)) ;; 排除 \\p，继续查找下一个 \p<br />       (progn<br />         ;; 查找分号 ;<br />         (setq pos2 (vl-string-search ";" text pos1))<br />         (if pos2<br />           (progn<br />             ;; 删除 \p 到 ; 的内容<br />             (setq text (strcat (substr text 1 pos1) (substr text (+ pos2 2))))<br />             (setq pos1 0) ;; 重新开始查找<br />           )<br />           (setq pos1 (strlen text)) ;; 如果没有分号，结束查找<br />         )<br />       )<br />     )<br />   )<br />   text<br /> )<br /> <br /> ;; 辅助函数：在 \P 分隔符后添加行距参数<br /> (defun add-line-spacing (text / pos1 pos2)<br />   ;; 查找第一个 \P 的位置<br />   (setq pos1 (vl-string-search "\\P" text))<br />   (if pos1<br />     (progn<br />       ;; 在第一个 \P 后添加 \pxse0.25;<br />       (setq text (strcat (substr text 1 (+ pos1 2)) "\\pxse0.25;" (substr text (+ pos1 3))))<br />       <br />       ;; 查找第二个 \P 的位置<br />       (setq pos2 (vl-string-search "\\P" text (+ pos1 3)))<br />       (if pos2<br />         ;; 在第二个 \P 后添加 \psm0.6;<br />         (setq text (strcat (substr text 1 (+ pos2 2)) "\\psm0.6;" (substr text (+ pos2 3))))<br />       )<br />     )<br />   )<br />   text<br /> )<br />

插件的效果是让标注文字更贴近引线的直线。



最后问一下各位大佬，怎么样调试插件和查看代码各个单词的意思？之前是一遍遍新建图纸再加载测试效果的。

冒个烟圈

** Error: no function definition: REMOVE-P-FORMAT-CODES **
差一个函数