[LISP程序]：请xyp1964兄弟看看里面连续标注的程序，那里出了问题！

gcb998

;;;File Name:dimcont.lsp

;;;by An Yuhui

;;;1-25-1996

;;;Function:Continue Dimension

;;;**********

(defun c:dimcont()

(setq spt(getpoint ″\nFirst point:″))

(setq ept(getpoint spt ″\nEnd point:″))

(setq just-ang(angle spt ept))

(setq ss(ssget ″F″(list spt ept)))

(setq index 0 ptlist nil)

(while (setq et (ssname ss index))

(if(=(cdr (assoc 0 (entget et))) ″POLYLINE″)

(progn

(command ″EXPLODE″et)

(setq et(entlast))

)

)

(setq etlist (entget et))

(setq pt1(getvalue 10 etlist))

(setq pt2(getvalue 11 etlist))

(setq ptlist(cons (inters pt1 pt2 spt ept nil)ptlist))

(setq index(1+index))

)

(setq ptlist(sort1 ptlist))

(setq lastpt(car ptlist))

(setq ptlist(cdr ptlist))

(while(setq pt (car ptlist))

(cond((or(=just-and0) (=just-ang pi))

(command ″dim1″ ″hor″ lastpt pt pt ″″)

(setq ptlist(cdr ptlist))

(setq lastpt pt)

)

((or (=just-ang (*pi 0.5)) (=just-ang(* pi 1.5)))

(command ″dim1″ ″ver″ lastpt pt pt ″″)

(setq ptlist(cdr ptlist))

(setq lastpt pt)

)

)

)

(princ)

)

以上是实现尺寸线的连续标注的程序 AutoCAD的DIM命令中有一个Continue连续标注命令,它的作用是 在标注完一个尺寸线后,在这条尺寸线的基础上对另一条开始进行标 注,其实在使用时仍要不断地键入命令,同时当标注水平的一连串线段时,很有可能高高低低的对不齐。以下的程序可以实现真正意义上的水平或垂直线段连续标注,方便易用,而且速度快!

       如何修改上面的语句，希望早日解决，谢谢！

xyp1964

错误太多：引号″、(=just-ang、getvalue、(*pi 0.5)、(1+index)、……
重新修改：

2. [FONT=courier new]
   
3. (load "xyp_lib")
   
4. ;|加载通用函数(可在签名栏直接下载)
   
5. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
   
6. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
7. ★1·在acad.lsp中增加(load"xyp_lib")
   
8. ■2·在每个程序内增加(load"xyp_lib")
   
9. ■3·在command下，输入(load"xyp_lib")
   
10. ■4·在菜单.mnl中增加(load"xyp_lib")
    
11. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
    
12. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
13. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
14. |;
    
15. 
    
16. ;;;连续水平或垂直标注
    
17. ;;;File Name : dimcont.lsp
    
18. ;;;Function : Continue Dimension
    
19. (defun c:dimcont ()
    
20.   (cmdla0)
    
21.   (setvar "osmode" 0)
    
22.   (setvar "ORTHOMODE" 1)
    
23.   (setq        spt         (getpoint "\n起点 : ")
    
24.         ept         (getpoint spt "\n终点 : ")
    
25.         just-ang (angle spt ept)
    
26.         ss         (ssget "F" (list spt ept))
    
27.         index         -1
    
28.         ptlist         nil
    
29.   )
    
30.   (if (or (= just-ang 0)
    
31.           (= just-ang pi)
    
32.           (= just-ang (* pi 0.5))
    
33.           (= just-ang (* pi 1.5))
    
34.       )
    
35.     (progn
    
36.       (while (setq et (ssname ss (setq index (1+ index))))
    
37.         (if (or        (= (cdr (assoc 0 (entget et))) "POLYLINE")
    
38.                 (= (cdr (assoc 0 (entget et))) "LWPOLYLINE")
    
39.             )
    
40.           (progn
    
41.             (command "EXPLODE" et)
    
42.             (setq et (entlast))
    
43.           )
    
44.         )
    
45.         (setq etlist (entget et)
    
46.               pt1    (cdr (assoc 10 etlist))
    
47.               pt2    (cdr (assoc 11 etlist))
    
48.               ptlist (cons (inters pt1 pt2 spt ept nil) ptlist)
    
49.         )
    
50.       )
    
51.       (setq lastpt (car ptlist)
    
52.             ptlist (cdr ptlist)
    
53.       )
    
54.       (mkla "尺寸标注" 3)
    
55.       (while (setq pt (car ptlist))
    
56.         (cond ((or (= just-ang 0) (= just-ang pi))
    
57.                (command "dim1" "hor" lastpt pt pt1 "")
    
58.                (setq ptlist (cdr ptlist)
    
59.                      lastpt pt
    
60.                )
    
61.               )
    
62.               ((or (= just-ang (* pi 0.5)) (= just-ang (* pi 1.5)))
    
63.                (command "dim1" "ver" lastpt pt pt "")
    
64.                (setq ptlist (cdr ptlist)
    
65.                      lastpt pt
    
66.                )
    
67.               )
    
68.               (t (princ))
    
69.         )
    
70.       )
    
71.     )
    
72.   )
    
73.   (cmdla1)
    
74. )
    
75. [/FONT]

[FONT=courier new]<br /> (load "xyp_lib")<br /> ;|加载通用函数(可在签名栏直接下载)<br /> 如果已经下载xyp_lib并放到搜索路径下可以不再下载!<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib")<br /> ■2·在每个程序内增加(load"xyp_lib")<br /> ■3·在command下，输入(load"xyp_lib")<br /> ■4·在菜单.mnl中增加(load"xyp_lib")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> |;<br /> <br /> ;;;连续水平或垂直标注<br /> ;;;File Name : dimcont.lsp <br /> ;;;Function : Continue Dimension <br /> (defun c:dimcont ()<br />   (cmdla0)<br />   (setvar "osmode" 0)<br />   (setvar "ORTHOMODE" 1)<br />   (setq        spt         (getpoint "\n起点 : ")<br />         ept         (getpoint spt "\n终点 : ")<br />         just-ang (angle spt ept)<br />         ss         (ssget "F" (list spt ept))<br />         index         -1<br />         ptlist         nil<br />   )<br />   (if (or (= just-ang 0)<br />           (= just-ang pi)<br />           (= just-ang (* pi 0.5))<br />           (= just-ang (* pi 1.5))<br />       )<br />     (progn<br />       (while (setq et (ssname ss (setq index (1+ index))))<br />         (if (or        (= (cdr (assoc 0 (entget et))) "POLYLINE")<br />                 (= (cdr (assoc 0 (entget et))) "LWPOLYLINE")<br />             )<br />           (progn<br />             (command "EXPLODE" et)<br />             (setq et (entlast))<br />           )<br />         )<br />         (setq etlist (entget et)<br />               pt1    (cdr (assoc 10 etlist))<br />               pt2    (cdr (assoc 11 etlist))<br />               ptlist (cons (inters pt1 pt2 spt ept nil) ptlist)<br />         )<br />       )<br />       (setq lastpt (car ptlist)<br />             ptlist (cdr ptlist)<br />       )<br />       (mkla "尺寸标注" 3)<br />       (while (setq pt (car ptlist))<br />         (cond ((or (= just-ang 0) (= just-ang pi))<br />                (command "dim1" "hor" lastpt pt pt1 "")<br />                (setq ptlist (cdr ptlist)<br />                      lastpt pt<br />                )<br />               )<br />               ((or (= just-ang (* pi 0.5)) (= just-ang (* pi 1.5)))<br />                (command "dim1" "ver" lastpt pt pt "")<br />                (setq ptlist (cdr ptlist)<br />                      lastpt pt<br />                )<br />               )<br />               (t (princ))<br />         )<br />       )<br />     )<br />   )<br />   (cmdla1)<br /> )<br /> [/FONT]