多重引线标注改文字和直线的距离
本帖最后由 woshilj 于 2025-2-13 09:31 编辑没有学过编程，之前一直在这里当伸手党，最近deepseek比较火热，于是也用来写了一个小插件，写完也调试了很多遍，最后终于能跑了，当然代码写的不够好看，主打一个能跑就行。现在直接分享源码，看看大佬们有空的话优化一下更美观。
(defun c:CML (/ ss idx mleader entData textContent newContent obj)
;; 选择多重引线
(prompt "\n选择多重引线: ")
(setq ss (ssget '((0 . "MULTILEADER"))))
(if ss
(progn
(setq idx 0)
(while (< idx (sslength ss))
(setq mleader (ssname ss idx))
(setq entData (entget mleader))
;; 获取多重引线内的多行文字内容（组码 304）
(setq textContent (cdr (assoc 304 entData)))
;; 清除所有以 \p 开始、以 ; 结尾的格式代码（排除 \\p 的情况）
(setq textContent (remove-p-format-codes textContent))
;; 在文字最前面添加 \pxse1.2;
(setq newContent (strcat "\\pxse1.2;" textContent))
;; 在 \P 分隔符后添加行距参数
(setq newContent (add-line-spacing newContent))
;; 更新多重引线的多行文字内容
(setq entData (subst (cons 304 newContent) (assoc 304 entData) entData))
(entmod entData)
(entupd mleader)
;; 获取多重引线的 ActiveX 对象
(setq obj (vlax-ename->vla-object mleader))
;; 设置连接位置 - 左为第一行加下划线
(vlax-put obj 'TextLeftAttachmentType 3)
;; 设置连接位置 - 右为第一行加下划线
(vlax-put obj 'TextRightAttachmentType 3)
;; 设置箭头样式为无
(vlax-put obj 'ArrowheadType 19)
;; 设置基线距离为 0.5
(vlax-put obj 'DoglegLength 0.5)
(setq idx (1+ idx))
)
(prompt "\n多重引线内多行文字段落行距修改完成，并设置连接位置为第一行加下划线，箭头样式为无，基线距离为 0.5。")
)
(prompt "\n未选择到多重引线。")
)
(princ)
)
;; 辅助函数：清除所有以 \p 开始、以 ; 结尾的格式代码（排除 \\p 的情况）
(defun remove-p-format-codes (text / pos1 pos2)
(setq pos1 0)
(while (setq pos1 (vl-string-search "\\p" text pos1))
;; 检查 \p 前面是否有 \ 符号
(if (and (> pos1 0) (eq (substr text pos1 1) "\\"))
(setq pos1 (+ pos1 2)) ;; 排除 \\p，继续查找下一个 \p
(progn
;; 查找分号 ;
(setq pos2 (vl-string-search ";" text pos1))
(if pos2
(progn
;; 删除 \p 到 ; 的内容
(setq text (strcat (substr text 1 pos1) (substr text (+ pos2 2))))
(setq pos1 0) ;; 重新开始查找
)
(setq pos1 (strlen text)) ;; 如果没有分号，结束查找
)
)
)
)
text
)
;; 辅助函数：在 \P 分隔符后添加行距参数
(defun add-line-spacing (text / pos1 pos2)
;; 查找第一个 \P 的位置
(setq pos1 (vl-string-search "\\P" text))
(if pos1
(progn
;; 在第一个 \P 后添加 \pxse0.25;
(setq text (strcat (substr text 1 (+ pos1 2)) "\\pxse0.25;" (substr text (+ pos1 3))))
;; 查找第二个 \P 的位置
(setq pos2 (vl-string-search "\\P" text (+ pos1 3)))
(if pos2
;; 在第二个 \P 后添加 \psm0.6;
(setq text (strcat (substr text 1 (+ pos2 2)) "\\psm0.6;" (substr text (+ pos2 3))))
)
)
)
text
)
插件的效果是让标注文字更贴近引线的直线。
最后问一下各位大佬，怎么样调试插件和查看代码各个单词的意思？之前是一遍遍新建图纸再加载测试效果的。
** Error: no function definition: REMOVE-P-FORMAT-CODES **
差一个函数
页:
[1]