[求助]：求能在R14下运行的批量标注直线的LISP程序

同心

求能在R14下运行的批量标注直线的LISP程序
其中尺寸线和尺寸界线隐藏

carrot1983

2. 
   
3. (defun C:TT (/ CMDECHO E ELIST I SS V10 V11)
   
4.   (princ "\n★批量标注直线 by carrot1983 11/30/09")
   
5.   (setq cmdEcho (getvar "CMDECHO"))
   
6.   (setvar "CMDECHO" 0)
   
7.   (command "._UNDO" "_END")
   
8.   (command "._UNDO" "_BEGIN")
   
9.   (if (setq ss (ssget '((0 . "LINE"))))
   
10.     (progn
    
11.       (repeat (setq i (sslength ss))
    
12.         (setq e (ssname ss (setq i (1- i))))
    
13.         (setq eList (entget e))
    
14.         (setq v10 (cdr (assoc 10 eList)))
    
15.         (setq v11 (cdr (assoc 11 eList)))
    
16.         (setq disList (cons (distance v10 v11) disList))
    
17.         (command "._DIMALIGNED" "_NON" v10 "_NON" v11 "_NON" v11)
    
18.       )
    
19. 
    
20.       (setq totalLength (apply '+ disList))
    
21.       (princ (strcat "\n★直线总长: " (rtos totalLength 2 3)))
    
22.     )
    
23.   )
    
24.   (command "._UNDO" "_END")
    
25.   (setvar "CMDECHO" cmdEcho)
    
26.   (princ)
    
27. )
    

<br /> (defun C:TT (/ CMDECHO E ELIST I SS V10 V11)<br />   (princ "\n★批量标注直线 by carrot1983 11/30/09")<br />   (setq cmdEcho (getvar "CMDECHO"))<br />   (setvar "CMDECHO" 0)<br />   (command "._UNDO" "_END")<br />   (command "._UNDO" "_BEGIN")<br />   (if (setq ss (ssget '((0 . "LINE"))))<br />     (progn<br />       (repeat (setq i (sslength ss))<br />         (setq e (ssname ss (setq i (1- i))))<br />         (setq eList (entget e))<br />         (setq v10 (cdr (assoc 10 eList)))<br />         (setq v11 (cdr (assoc 11 eList)))<br />         (setq disList (cons (distance v10 v11) disList))<br />         (command "._DIMALIGNED" "_NON" v10 "_NON" v11 "_NON" v11)<br />       )<br /> <br />       (setq totalLength (apply '+ disList))<br />       (princ (strcat "\n★直线总长: " (rtos totalLength 2 3)))<br />     )<br />   )<br />   (command "._UNDO" "_END")<br />   (setvar "CMDECHO" cmdEcho)<br />   (princ)<br /> )<br />

同心

非常谢谢carrot1983  ，您的程序给我工作带来了很大的方便，程序非常适用