自动编号问题

love1030312

各位大神门   这是个编号程序  论坛上有很多  但都不能在执行命令的时候让选择输入字的大小 都是默认程序里边的大小  请大神门帮忙完善下  谢谢啊

672505821

zmzk 发表于 2022-1-29 17:56
加入这些封闭图形 大小不一样，排序还是会出现问题的

这就需要用到排序了，这个只是对图元出现的顺序进行排序

296715530

edata 发表于 2016-8-4 21:49
这个就是上面的代码文件，选择对象，根据对象顺序填写序号。命令 tt

数字位置能改吗

zmzk

加入这些封闭图形 大小不一样，排序还是会出现问题的

edata

顺序已改

1. (defun c:tt(/ ss font_height1 n k po na)
   
2.      (or font_height (setq font_height 100))
   
3.       (if(setq font_height1(getdist (strcat "\n输入文字高度<"(rtos font_height 2 )  ">:")))
   
4.         (setq font_height font_height1))
   
5.   (if(and (setq ss (ssget (list '(0 . "LWPOLYLINE"))))
   
6.           )
   
7.     (progn
   
8.   (setq n 0 k 1)
   
9.   (repeat (sslength ss)
   
10.     (setq na (ssname ss n))
    
11.     (setq po (Get_center_relative na))
    
12.     (entmake (list '(0 . "MTEXT")
    
13.                    '(100 . "AcDbEntity")
    
14.                    '(100 . "AcDbMText")
    
15.                    (cons 7(getvar 'TEXTSTYLE))
    
16.                    (cons 1 (rtos k 2 0))
    
17.                    (cons 10 po)
    
18.                    (cons 40 font_height)
    
19.                    (cons 71 5)
    
20.                    )
    
21.              )
    
22.     ;(command "text" "j" "mc" "non" po font_height 0 k "")
    
23.     (setq k (1+ k))
    
24.     (setq n (1+ n))
    
25.     )
    
26.   )
    
27.     )
    
28.   (princ)
    
29.   )
    
30. 
    
31. (defun Get_center_relative (ename /  Pts   2R Mk   Mkline  points   DelLine   Tssred
    
32.                    i   lst  N  Newlst    DistList     R   Number  Tssbak TssSub  Pt)
    
33.     (setq Obj     (Vlax-Ename->Vla-Object ename)
    
34.           Tssbak  (Vlax-Get Obj 'Thickness )
    
35.           TssSub  (Vlax-Put Obj 'Thickness 0 ))
    
36.     (setq Pts     (GetBoundingBox ename)
    
37.           2R      (MJ:MIDPOINT (CAR Pts) (CADR Pts))
    
38.           Mk      (entmake (list (cons 0 "LINE")(cons 8 "JMDSS")(cons 10 (polar 2R 0.0 1000))(cons 11 (polar 2R 3.14159 1000))))
    
39.           Mkline  (entlast)
    
40.           points  (vlax-invoke (vlax-ename->vla-object ename) 'IntersectWith (vlax-ename->vla-object Mkline) acExtendOtherEntity)
    
41.           Tssred  (Vlax-Put Obj 'Thickness (eval Tssbak) )
    
42.           DelLine (entdel Mkline)
    
43.           i       0
    
44.           lst     nil
    
45.           )
    
46.   (repeat (/ (length points) 3)
    
47.        (setq lst (append lst (list (list (nth i points) (nth (1+ i) points) (nth (+ 2 i) points)))))
    
48.        (setq i (+ i 3))
    
49.   )
    
50.   (setq lst (px lst))
    
51.   (if (>= (length lst) 4)
    
52.       (progn
    
53.           (setq N      0
    
54.                 Newlst nil)
    
55.           (repeat (/ (length lst) 2)
    
56.               (setq Newlst (append Newlst (list (list (nth N lst) (nth (1+ N) lst)))))
    
57.               (setq N (+ 2 N))
    
58.           )
    
59.           (setq DistList nil
    
60.                 R        0)
    
61.           (repeat (length Newlst)
    
62.             (setq Number (nth R Newlst)
    
63.                   DistList (append DistList  (list(distance (car Number) (cadr Number)))))
    
64.             (setq R (1+ R))
    
65.           )
    
66.           (setq  Pt (nth (vl-position (car (vl-sort DistList '>)) DistList) Newlst))
    
67.         (MJ:MIDPOINT (car pt) (cadr pt));返回值
    
68.       )
    
69.       (MJ:MIDPOINT (car lst) (cadr lst));返回值
    
70.   )
    
71. )
    
72. 
    
73. (defun MJ:MIDPOINT (P1 P2)
    
74.   (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
    
75. )
    
76. 
    
77. (defun GetBoundingBox (ent / ll ur)
    
78.     (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
    
79.     (mapcar 'vlax-safearray->list (list ll ur))
    
80. )
    
81. 
    
82. (defun px (X)
    
83.     (vl-sort  X
    
84.              (function (lambda (e1 e2)
    
85.                          (< (car e1) (car e2)) ) ) )
    
86. )
    
87. 
    

(defun c:tt(/ ss font_height1 n k po na)<br />      (or font_height (setq font_height 100))<br />       (if(setq font_height1(getdist (strcat "\n输入文字高度<"(rtos font_height 2 )  ">:")))<br />         (setq font_height font_height1))<br />   (if(and (setq ss (ssget (list '(0 . "LWPOLYLINE"))))<br />           )<br />     (progn <br />   (setq n 0 k 1)<br />   (repeat (sslength ss)<br />     (setq na (ssname ss n))<br />     (setq po (Get_center_relative na))<br />     (entmake (list '(0 . "MTEXT")<br />                    '(100 . "AcDbEntity")<br />                    '(100 . "AcDbMText")<br />                    (cons 7(getvar 'TEXTSTYLE))<br />                    (cons 1 (rtos k 2 0))<br />                    (cons 10 po)<br />                    (cons 40 font_height)<br />                    (cons 71 5)<br />                    )<br />              )<br />     ;(command "text" "j" "mc" "non" po font_height 0 k "")<br />     (setq k (1+ k))<br />     (setq n (1+ n))<br />     )<br />   )<br />     )<br />   (princ)<br />   )<br /> <br /> (defun Get_center_relative (ename /  Pts   2R Mk   Mkline  points   DelLine   Tssred<br />                    i   lst  N  Newlst    DistList     R   Number  Tssbak TssSub  Pt)<br />     (setq Obj     (Vlax-Ename->Vla-Object ename)<br />           Tssbak  (Vlax-Get Obj 'Thickness )<br />           TssSub  (Vlax-Put Obj 'Thickness 0 ))<br />     (setq Pts     (GetBoundingBox ename)<br />           2R      (MJ:MIDPOINT (CAR Pts) (CADR Pts))<br />           Mk      (entmake (list (cons 0 "LINE")(cons 8 "JMDSS")(cons 10 (polar 2R 0.0 1000))(cons 11 (polar 2R 3.14159 1000))))<br />           Mkline  (entlast)<br />           points  (vlax-invoke (vlax-ename->vla-object ename) 'IntersectWith (vlax-ename->vla-object Mkline) acExtendOtherEntity)<br />           Tssred  (Vlax-Put Obj 'Thickness (eval Tssbak) )<br />           DelLine (entdel Mkline)<br />           i       0<br />           lst     nil<br />           )<br />   (repeat (/ (length points) 3)<br />        (setq lst (append lst (list (list (nth i points) (nth (1+ i) points) (nth (+ 2 i) points)))))<br />        (setq i (+ i 3))<br />   )<br />   (setq lst (px lst))<br />   (if (>= (length lst) 4)<br />       (progn<br />           (setq N      0<br />                 Newlst nil)<br />           (repeat (/ (length lst) 2)<br />               (setq Newlst (append Newlst (list (list (nth N lst) (nth (1+ N) lst)))))<br />               (setq N (+ 2 N))<br />           )<br />           (setq DistList nil<br />                 R        0)<br />           (repeat (length Newlst)<br />             (setq Number (nth R Newlst) <br />                   DistList (append DistList  (list(distance (car Number) (cadr Number)))))<br />             (setq R (1+ R))<br />           )<br />           (setq  Pt (nth (vl-position (car (vl-sort DistList '>)) DistList) Newlst))<br />         (MJ:MIDPOINT (car pt) (cadr pt));返回值<br />       )<br />       (MJ:MIDPOINT (car lst) (cadr lst));返回值<br />   )<br /> )<br /> <br /> (defun MJ:MIDPOINT (P1 P2)<br />   (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)<br /> )<br /> <br /> (defun GetBoundingBox (ent / ll ur)<br />     (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)<br />     (mapcar 'vlax-safearray->list (list ll ur))<br /> )<br /> <br /> (defun px (X)<br />     (vl-sort  X<br />              (function (lambda (e1 e2) <br />                          (< (car e1) (car e2)) ) ) )<br /> )<br /> <br />

love1030312

edata 发表于 2014-6-10 16:42

大哥  谢谢 啊  就是这样的    但是能帮我改下顺序吗？  你这个是反的  能改正码 ？（你的开始数字和结束数字反过来下 ）  谢谢

cuyong123

喜欢！呵呵

edata

love1030312 发表于 2014-6-10 17:05
大哥  谢谢 啊  就是这样的    但是能帮我改下顺序吗？  你这个是反的  能改正码 ？（你的开始数字和结束 ...

数值是按照选择顺序排序的，如果是框选按图形建立逆向顺序排序。
关于这个排序，水很深，暂时不涉及。

翔飞125

edata 发表于 2014-6-11 09:56
数值是按照选择顺序排序的，如果是框选按图形建立逆向顺序排序。
关于这个排序，水很深，暂时不涉及。

若再能解决排序问题的话就更完美了

zzust

谢谢，学习的参考

906460210

没看明白，，，，，，，

906460210

求一个自动编号闭合面的插件

edata

906460210 发表于 2016-8-4 16:26
求一个自动编号闭合面的插件

这个就是上面的代码文件，选择对象，根据对象顺序填写序号。命令 tt