求LISP程序：一键调整标注比例、文字与引线对齐及大小调整
求LISP程序：一键调整尺寸标注比例、文字与引线对齐方式及大小调整本帖最后由 vitalgg 于 2024-3-12 19:03 编辑
https://atlisp.cn/static/videos/btdim.mp4
(progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
(defun btdim ()
(setq dims (pickset:to-list (ssget '((0 . "LEADER,DIMENSION")))))
;; 修改引线和标注的 scaleFactor 为统一值
(mapcar (function(lambda (x) (vla-put-ScaleFactor (e2o x) 1.5))) dims)
;; 选中引线末端文字，修正文字的起点
;; 修改文字为统一高度
(foreach leader
(vl-remove-if '(lambda (x) (eq "DIMENSION" (entity:getdxf x 0))) dims)
;; 取引线点并反序
(setq pts (reverse (entity:getdxf leader 10)))
;; 取末端文字
(if (setq txt (car
(pickset:to-list
(ssget "f"
(list (polar (car pts)(* 1.5 pi) 2)
(polar
(polar (car pts)(* 0.5 pi) 2)
(angle (cadr pts) (car pts))
10) ;; 文字范围
)
'((0 . "text"))))))
(progn
;; 设文字高度
(entity:putdxf txt 40 6.0)
;; 设文字位置
(vla-put-Alignment (e2o txt)
(if (> (car (cadr pts)) (car (car pts)))
11 9))
(vla-put-TextAlignmentPoint
(e2o txt)
(point:to-ax (polar (car pts)(angle (cadr pts) (car pts))1))
)))))
本帖最后由 ssyfeng 于 2024-3-8 10:18 编辑
看看是不是这个效果：
xyp1964 发表于 2024-3-8 13:58
反馈; 错误: *error* 函数中出错参数太多，我的是2008的 xyp1964 发表于 2024-3-8 13:58
报错：tt ; 错误: no function definition: XYP-START
用的CAD2020 ssyfeng 发表于 2024-3-8 09:00
看看是不是这个效果：
是的，就是要这效果！ fengyu6913 发表于 2024-3-8 18:02
报错：tt ; 错误: no function definition: XYP-START
用的CAD2020
要加载院长的函数库啊 bai2000 发表于 2024-3-8 19:13
要加载院长的函数库啊
新人出来扎到，院长的数据库可以分享下吗，谢谢大哥 ssyfeng 发表于 2024-3-8 09:00
看看是不是这个效果：
大佬，正是此效果，可否把代码分享一下
页:
[1]
2