CAD开发：重新自动排列所选文字-ret

lrd1861

兄弟插件呢？？？

x_s_s_1

插件在这:l

2. (defun c:test1
   
3.        (/ LM:GetXWithDefault getdxf trimstring ss m n i lst str)
   
4.   (defun LM:GetXWithDefault (_function   _prompt     _symbol
   
5.            _default   _initget    _args
   
6.            /     _toString
   
7.           )
   
8.     (setq _toString
   
9.      (lambda (x)
   
10.        (cond
    
11.          ((eq getangle _function) (angtos x))
    
12.          ((eq 'REAL (type x)) (rtos x))
    
13.          ((eq 'INT (type x)) (itoa x))
    
14.          ((vl-princ-to-string x))
    
15.        )
    
16.      )
    
17.     )
    
18.     (if  _initget
    
19.       (apply 'initget _initget)
    
20.     )
    
21.     (set _symbol
    
22.    (
    
23.     (lambda (input)
    
24.       (if  (or (not input) (eq "" input))
    
25.         (eval _symbol)
    
26.         input
    
27.       )
    
28.     )
    
29.      (apply '_function
    
30.       (append _args
    
31.         (list
    
32.           (strcat _prompt
    
33.             "<"
    
34.             (_toString
    
35.               (set _symbol
    
36.              (cond
    
37.                ((eval _symbol))
    
38.                (_default)
    
39.              )
    
40.               )
    
41.             )
    
42.             "> : "
    
43.           )
    
44.         )
    
45.       )
    
46.      )
    
47.    )
    
48.     )
    
49.   )
    
50.   (defun getdxf (dxf en) (cdr (assoc dxf (entget en))))
    
51.   (defun trimstring (str / left right)
    
52.     (setq left (vl-string-right-trim "1234567890" str))
    
53.     (if  (= left "")
    
54.       (setq right str)
    
55.       (setq right (vl-string-left-trim left str))
    
56.     )
    
57.     (list left right)
    
58.   )
    
59.   (setq ss (ssget '((0 . "text"))))
    
60.   (repeat (setq i (sslength ss))
    
61.     (setq en  (ssname ss (setq i (1- i)))
    
62.     lst (cons en lst)
    
63.     )
    
64.   )
    
65.   (setq  lst
    
66.    (vl-sort
    
67.      lst
    
68.      '(lambda (t1 t2)
    
69.         (< (atoi (cadr (trimstring (getdxf 1 t1))))
    
70.      (atoi (cadr (trimstring (getdxf 1 t2))))
    
71.         )
    
72.       )
    
73.    )
    
74.   )
    
75.   (setq n (LM:GetXWithDefault getint "\n输入起始值" '**n** 1 nil nil))
    
76.   (setq m (LM:GetXWithDefault getint "\n输入步长" '**m** 1 nil nil))
    
77.   (foreach en lst
    
78.     (setq ent (entget en)
    
79.     str (car (trimstring (cdr (assoc 1 ent))))
    
80.     ent (subst (cons 1 (strcat str (itoa n))) (assoc 1 ent) ent)
    
81.     n   (+ m n)
    
82.     )
    
83.     (entmod ent)
    
84.     (entupd en)
    
85.   )
    
86. )
    

(defun c:test1<br />        (/ LM:GetXWithDefault getdxf trimstring ss m n i lst str)<br />   (defun LM:GetXWithDefault (_function   _prompt     _symbol<br />            _default   _initget    _args<br />            /     _toString<br />           )<br />     (setq _toString<br />      (lambda (x)<br />        (cond<br />          ((eq getangle _function) (angtos x))<br />          ((eq 'REAL (type x)) (rtos x))<br />          ((eq 'INT (type x)) (itoa x))<br />          ((vl-princ-to-string x))<br />        )<br />      )<br />     )<br />     (if  _initget<br />       (apply 'initget _initget)<br />     )<br />     (set _symbol<br />    (<br />     (lambda (input)<br />       (if  (or (not input) (eq "" input))<br />         (eval _symbol)<br />         input<br />       )<br />     )<br />      (apply '_function<br />       (append _args<br />         (list<br />           (strcat _prompt<br />             "<"<br />             (_toString<br />               (set _symbol<br />              (cond<br />                ((eval _symbol))<br />                (_default)<br />              )<br />               )<br />             )<br />             "> : "<br />           )<br />         )<br />       )<br />      )<br />    )<br />     )<br />   )<br />   (defun getdxf (dxf en) (cdr (assoc dxf (entget en))))<br />   (defun trimstring (str / left right)<br />     (setq left (vl-string-right-trim "1234567890" str))<br />     (if  (= left "")<br />       (setq right str)<br />       (setq right (vl-string-left-trim left str))<br />     )<br />     (list left right)<br />   )<br />   (setq ss (ssget '((0 . "text"))))<br />   (repeat (setq i (sslength ss))<br />     (setq en  (ssname ss (setq i (1- i)))<br />     lst (cons en lst)<br />     )<br />   )<br />   (setq  lst<br />    (vl-sort<br />      lst<br />      '(lambda (t1 t2)<br />         (< (atoi (cadr (trimstring (getdxf 1 t1))))<br />      (atoi (cadr (trimstring (getdxf 1 t2))))<br />         )<br />       )<br />    )<br />   )<br />   (setq n (LM:GetXWithDefault getint "\n输入起始值" '**n** 1 nil nil))<br />   (setq m (LM:GetXWithDefault getint "\n输入步长" '**m** 1 nil nil))<br />   (foreach en lst<br />     (setq ent (entget en)<br />     str (car (trimstring (cdr (assoc 1 ent))))<br />     ent (subst (cons 1 (strcat str (itoa n))) (assoc 1 ent) ent)<br />     n   (+ m n)<br />     )<br />     (entmod ent)<br />     (entupd en)<br />   )<br /> )<br />

kkdolphin

楼上厉害

dmxy

x_s_s_1 发表于 2019-12-28 12:22
插件在这:l

测试提示 输入的字符串有缺陷

x_s_s_1

网站的问题，代码含有特殊符号，被吃掉了，换浏览器或者自己找出哪里缺少了，补上

1211277255

兄弟插件呢？？？

yoyoho

x_s_s_1 发表于 2019-12-28 12:22
插件在这:l

谢谢! x_s_s_1 分享程序 AUTOCAD 2012 测试 O.K.

baoxiaozhong

ssdsfg 发表于 2019-12-28 10:59
有点小问题，正在调试...谢谢大家关注！

是已經調試好了才收幣嗎?

收幣的內容是原碼還是?

ssdsfg

baoxiaozhong 发表于 2019-12-29 15:19
是已經調試好了才收幣嗎?

收幣的內容是原碼還是?

调试好了。不是LISP原码，是编译过的.vlx格式，可以正常使用！

ssdsfg

x_s_s_1 发表于 2019-12-28 12:22
插件在这:l

有相同之处，但也有不同。大家各取所需