求LISP程序：一键调整标注比例、文字与引线对齐及大小调整

fengyu6913

求LISP程序：一键调整尺寸标注比例、文字与引线对齐方式及大小调整

vitalgg

如果无法播放，请点击此处在新窗口打开

1. (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))))
   
2. (defun btdim ()
   
3.   (setq dims (pickset:to-list (ssget '((0 . "LEADER,DIMENSION")))))
   
4.   ;; 修改引线和标注的 scaleFactor 为统一值
   
5.   (mapcar (function(lambda (x) (vla-put-ScaleFactor (e2o x) 1.5))) dims)
   
6.   ;; 选中引线末端文字，修正文字的起点
   
7.   ;; 修改文字为统一高度
   
8.   (foreach leader
   
9.     (vl-remove-if '(lambda (x) (eq "DIMENSION" (entity:getdxf x 0))) dims)
   
10.     ;; 取引线点并反序
    
11.     (setq pts (reverse (entity:getdxf leader 10)))
    
12.     ;; 取末端文字
    
13.     (if (setq txt (car
    
14.                   (pickset:to-list
    
15.                     (ssget "f"
    
16.                       (list (polar (car pts)(* 1.5 pi) 2)
    
17.                         (polar
    
18.                           (polar (car pts)(* 0.5 pi) 2)
    
19.                           (angle (cadr pts) (car pts))
    
20.                           10) ;; 文字范围
    
21.                       )
    
22.                       '((0 . "text"))))))
    
23.       (progn
    
24.         ;; 设文字高度
    
25.         (entity:putdxf txt 40 6.0)
    
26.         ;; 设文字位置
    
27.         (vla-put-Alignment (e2o txt)
    
28.           (if (> (car (cadr pts)) (car (car pts)))
    
29.             11 9))
    
30.         (vla-put-TextAlignmentPoint
    
31.           (e2o txt)
    
32.           (point:to-ax (polar (car pts)(angle (cadr pts) (car pts))1))
    
33.           )))))

(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))))<br /> (defun btdim () <br />   (setq dims (pickset:to-list (ssget '((0 . "LEADER,DIMENSION")))))<br />   ;; 修改引线和标注的 scaleFactor 为统一值<br />   (mapcar (function(lambda (x) (vla-put-ScaleFactor (e2o x) 1.5))) dims)<br />   ;; 选中引线末端文字，修正文字的起点<br />   ;; 修改文字为统一高度<br />   (foreach leader <br />     (vl-remove-if '(lambda (x) (eq "DIMENSION" (entity:getdxf x 0))) dims)<br />     ;; 取引线点并反序<br />     (setq pts (reverse (entity:getdxf leader 10)))<br />     ;; 取末端文字<br />     (if (setq txt (car <br />                   (pickset:to-list <br />                     (ssget "f"<br />                       (list (polar (car pts)(* 1.5 pi) 2)<br />                         (polar <br />                           (polar (car pts)(* 0.5 pi) 2)<br />                           (angle (cadr pts) (car pts))<br />                           10) ;; 文字范围<br />                       )<br />                       '((0 . "text"))))))<br />       (progn <br />         ;; 设文字高度<br />         (entity:putdxf txt 40 6.0)<br />         ;; 设文字位置<br />         (vla-put-Alignment (e2o txt)<br />           (if (> (car (cadr pts)) (car (car pts))) <br />             11 9))<br />         (vla-put-TextAlignmentPoint <br />           (e2o txt)<br />           (point:to-ax (polar (car pts)(angle (cadr pts) (car pts))1))<br />           )))))

ssyfeng

看看是不是这个效果：

xyp1964

shirker

xyp1964 发表于 2024-3-8 13:58

反馈; 错误: *error* 函数中出错参数太多，我的是2008的

fengyu6913

xyp1964 发表于 2024-3-8 13:58

报错：tt ; 错误: no function definition: XYP-START
用的CAD2020

fengyu6913

ssyfeng 发表于 2024-3-8 09:00
看看是不是这个效果：

是的，就是要这效果！

bai2000

fengyu6913 发表于 2024-3-8 18:02
报错：tt ; 错误: no function definition: XYP-START
用的CAD2020

要加载院长的函数库啊

yimiyangguang55

bai2000 发表于 2024-3-8 19:13
要加载院长的函数库啊

新人出来扎到，院长的数据库可以分享下吗，谢谢大哥

fengyu6913

ssyfeng 发表于 2024-3-8 09:00
看看是不是这个效果：

大佬，正是此效果，可否把代码分享一下