@lisp: 动态图框 新增图纸自动编号功能。

vitalgg

新增图框自动编号功能 。就是改图框里的图号，从左到右，从上到下，把图号按顺序改写（不是移动排版，只是改图号）

命令行输入 @U 自动升级到新版

那就给个源码：

2. (defun @:get-frames (/ s1 ss-list ename en0 ti% p ml-contents xmax ymin boxscale insp)
   
3.   "选取图中的图框"
   
4.   (prompt "回车或右键则为所有图框")
   
5.   (setq s1 (ssget '((0 . "INSERT"))))
   
6.   (setq ss-list '())
   
7.   (if (null s1)
   
8.       (setq s1 (ssget "x" '((0 . "INSERT")))))
   
9.   (setq ti% 0)
   
10.   (if (/= s1 nil)
    
11.       (progn
    
12.   (while
    
13.       (<= ti% (- (sslength s1) 1))
    
14.     (setq en0 (ssname s1 ti%))
    
15.     (if (eq (block:get-effectivename en0) (@:get-config 'vitaltools:tukuang))
    
16.         (progn
    
17.     (setq ss-list (append ss-list (list en0)))
    
18.     ))
    
19.     (setq ti% (+ 1 ti%))
    
20.     )
    
21.   )
    
22.       (progn
    
23.   (alert (strcat "未选中任何图框，请检查配置文件中你的图框块名是 "
    
24.            (@:get-config 'vitaltools:tukuang)))
    
25.   (@:edit-config))
    
26.       )
    
27.   (vl-sort ss-list
    
28.      '(lambda (en1 en2)
    
29.        (if (> (caddr (assoc 10 (entget en1)))
    
30.         (+ 1000 (caddr (assoc 10 (entget en2)))))
    
31.      T
    
32.      (if (and (< (caddr (assoc 10 (entget en1)))
    
33.            (+ 1000 (caddr (assoc 10 (entget en2)))))
    
34.         (> (caddr (assoc 10 (entget en1)))
    
35.            (- (caddr (assoc 10 (entget en2))) 1000))
    
36.         (< (cadr (assoc 10 (entget en1)))
    
37.            (cadr (assoc 10 (entget en2)))))
    
38.          T
    
39.          nil)
    
40.      ))))
    
41. 
    
42. (@:add-menu "工程管理" "自动编图号" "(@:set-tuhao (@:get-frames))")
    
43. (defun @:set-tuhao (ss-list / num1 start )
    
44.   (setq start (getint "请输入图纸起始编号<1>:"))
    
45.   (if (null start) (setq start 1))
    
46.   (setq num1 0)
    
47.   ;;(print (length ss-list))
    
48.   (foreach en0 ss-list
    
49.      (block:set-attributes
    
50.       en0
    
51.       (list (cons "图号"
    
52.       (strcat (if (@:get-tubie (block:get-attributes en0))
    
53.             (strcat (@:get-tubie (block:get-attributes en0))
    
54.               "-")
    
55.             "")
    
56.         (if (< (+ num1 start) 10) "0" "")
    
57.         (itoa (+ num1 start))))))
    
58.      (setq num1 (1+ num1))
    
59.      ))
    

(defun @:get-frames (/ s1 ss-list ename en0 ti% p ml-contents xmax ymin boxscale insp)<br />   "选取图中的图框"<br />   (prompt "回车或右键则为所有图框")<br />   (setq s1 (ssget '((0 . "INSERT"))))<br />   (setq ss-list '())<br />   (if (null s1)<br />       (setq s1 (ssget "x" '((0 . "INSERT")))))<br />   (setq ti% 0)<br />   (if (/= s1 nil)<br />       (progn<br />   (while<br />       (<= ti% (- (sslength s1) 1))<br />     (setq en0 (ssname s1 ti%))<br />     (if (eq (block:get-effectivename en0) (@:get-config 'vitaltools:tukuang))<br />         (progn<br />     (setq ss-list (append ss-list (list en0)))<br />     ))<br />     (setq ti% (+ 1 ti%))<br />     )<br />   )<br />       (progn<br />   (alert (strcat "未选中任何图框，请检查配置文件中你的图框块名是 "<br />            (@:get-config 'vitaltools:tukuang)))<br />   (@:edit-config))<br />       )<br />   (vl-sort ss-list<br />      '(lambda (en1 en2)<br />        (if (> (caddr (assoc 10 (entget en1)))<br />         (+ 1000 (caddr (assoc 10 (entget en2)))))<br />      T<br />      (if (and (< (caddr (assoc 10 (entget en1)))<br />            (+ 1000 (caddr (assoc 10 (entget en2)))))<br />         (> (caddr (assoc 10 (entget en1)))<br />            (- (caddr (assoc 10 (entget en2))) 1000))<br />         (< (cadr (assoc 10 (entget en1)))<br />            (cadr (assoc 10 (entget en2)))))<br />          T<br />          nil)<br />      ))))<br /> <br /> (@:add-menu "工程管理" "自动编图号" "(@:set-tuhao (@:get-frames))")<br /> (defun @:set-tuhao (ss-list / num1 start )<br />   (setq start (getint "请输入图纸起始编号<1>:"))<br />   (if (null start) (setq start 1))<br />   (setq num1 0)<br />   ;;(print (length ss-list))<br />   (foreach en0 ss-list<br />      (block:set-attributes<br />       en0<br />       (list (cons "图号"<br />       (strcat (if (@:get-tubie (block:get-attributes en0))<br />             (strcat (@:get-tubie (block:get-attributes en0))<br />               "-")<br />             "")<br />         (if (< (+ num1 start) 10) "0" "")<br />         (itoa (+ num1 start))))))<br />      (setq num1 (1+ num1))<br />      ))<br />

vitalgg

paulpipi 发表于 2020-12-29 09:49
程序吗？等待分享

到 atlisp.cn 下载安装就有了，@lisp 是管理 lisp 程序的程序。方便用户安装 升级，及管理自己的程序加载库。

有新版本时 一个命令 @U 搞定升级.

不用你一个个的到网上搜索下载安装了。

vitalgg

kdanqu 发表于 2021-1-7 16:42
命令是啥啊？看不懂！！

菜单命令 “自动编图号”
命令行的话输入 (@:set-tuhao (@:get-frames))

就是把图框里的图号按从左到右，从上到下，按顺序排一下。如果你加了一张图，不用再逐个改图号了，一个命令就排好了。 需要安装  @lisp  , 访问 atlisp.cn 下载

vitalgg

cowboy110 发表于 2022-4-12 08:34
加载提示
文件中有不正确的快速加载格式: "C:/Users/admin/@lisp/packages/vitaltools/vitaltools-whole.F ...

@r  然后输入 vitaltools  。
去除这个应用。

这是一个老版本的工程管理。新版本名称改为 at-pm 了

paulpipi

程序吗？等待分享

lxl217114

这个有点意思，有图纸集内味了

菜卷鱼

vitalgg 发表于 2020-12-29 12:40
到 atlisp.cn 下载安装就有了，@lisp 是管理 lisp 程序的程序。方便用户安装 升级，及管理自己的程序加载 ...

发广告交广告费了吗？

429014673

楼主没看版规，原则上没程序源码只有广告是不能发这个版的

hnzkhyyl

楼主发个图片是几个意思？？？

vitalgg

429014673 发表于 2021-1-4 09:12
楼主没看版规，原则上没程序源码只有广告是不能发这个版的

那就发一段源码。 附件传不上去啊。

czb203

这个有点意思，有图纸集内味了

kdanqu

命令是啥啊？看不懂！！