[LISP程序]：请高手帮我改一下这个尺寸标注程序！

zhoujun518

ACAD的连续标注在FOREACH命令中不好用，总是错行，没办法，
我编了如下方法来实现连续标注（有些地方是其他用途），但我
我觉得很麻烦，那位老兄可以帮我想个简单的方法？

2. 
   
3.   [FONT=courier new]
   
4. (defun C:member_dim ()
   
5.   (setq        n3          0
   
6.         girt_list '("4@1800" "2000" "3000" "4000" "varies")
   
7.         bp_thn          25
   
8.   )
   
9.   (setq each_girt (nth n3 girt_list))
   
10.   (if (/= nil
    
11.           (setq posi (Vl-string-position (ASCII "@") each_girt))
    
12.       )
    
13.     (progn
    
14.       (dim_draw        (setq pre_pt (list (- bp_thn) 0))
    
15.                 '(0 0)
    
16.       )
    
17.       (repeat (atoi (substr each_girt 1 posi))
    
18.         (progn
    
19.           (dim_draw
    
20.             pre_pt
    
21.             (list (+ (car pre_pt) (atoi (substr each_girt (+ 2 posi))))
    
22.                   0
    
23.             ))
    
24.           (setq        pre_pt (list (+        (car pre_pt)
    
25.                                 (atoi (substr each_girt (+ 2 posi)))
    
26.                              )
    
27.                              0
    
28. )))))))
    
29. (defun Dim_draw        (dpt1 dpt2 /)
    
30.   (cond        ((= 0 dim_type)
    
31.          (vl-cmdf "_dimlinear"
    
32.                   dpt1
    
33.                   dpt2
    
34.                   (strcat "@0," (rtos 1500 2 15))
    
35. ))))
    
36.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun C:member_dim ()<br />   (setq        n3          0<br />         girt_list '("4@1800" "2000" "3000" "4000" "varies")<br />         bp_thn          25<br />   )<br />   (setq each_girt (nth n3 girt_list))<br />   (if (/= nil<br />           (setq posi (Vl-string-position (ASCII "@") each_girt))<br />       )<br />     (progn<br />       (dim_draw        (setq pre_pt (list (- bp_thn) 0))<br />                 '(0 0)<br />       )<br />       (repeat (atoi (substr each_girt 1 posi))<br />         (progn<br />           (dim_draw<br />             pre_pt<br />             (list (+ (car pre_pt) (atoi (substr each_girt (+ 2 posi))))<br />                   0<br />             ))<br />           (setq        pre_pt (list (+        (car pre_pt)<br />                                 (atoi (substr each_girt (+ 2 posi)))<br />                              )<br />                              0<br /> )))))))<br /> (defun Dim_draw        (dpt1 dpt2 /)<br />   (cond        ((= 0 dim_type)<br />          (vl-cmdf "_dimlinear"<br />                   dpt1<br />                   dpt2<br />                   (strcat "@0," (rtos 1500 2 15))<br /> ))))<br />   [/FONT]<br />

cy956

2. 
   
3. (defun #m_dim (d70 d50 d1 p10 p13 p14 lay color / en000)
   
4.   ;d70线性32对齐33; p10基点 p13第一点 p14第二点 d1强制长度值
   
5.   ;(#m_dim 32 0 "" p10 p13 p14 "dim" -1)
   
6.   ;(#m_dim 32 0 "" '(-3000 30000 0.0) '(-498.081 33511.0 0.0) '(-3198.08 33511.0 0.0) "dim" -1)
   
7.   (setq        en000 (list
   
8.               (cons 0 "DIMENSION")
   
9.               (cons 100 "AcDbEntity")
   
10.               (cons 8 lay)
    
11.               (cons 100 "AcDbDimension")
    
12.               (cons 10 p10)
    
13.               '(11 0 0 0)
    
14.               (cons 70 d70)
    
15.               (cons 1 d1)
    
16.               (cons 100 "AcDbAlignedDimension")
    
17.               (cons 13 p13)
    
18.               (cons 14 p14)
    
19.               (cons 50 d50)
    
20.             )
    
21.   )
    
22.   (if (= (logand d70 5)0)
    
23.     (setq en000(append en000 (list '(100 . "AcDbRotatedDimension")))))
    
24.   (if (/= -1 color) (setq en000 (append en000 (list (cons 62 color)))))
    
25.   (if (= nil (entmake en000)) (princ "\n制造 dim 实体失败.")  )
    
26. )
    
27. 
    
28. (defun cy_dim_pb(pb p0 a)   ;;;点表线性标注
    
29.   (setq p1(car pb)pb1(cdr pb)
    
30.         in 0)
    
31.   (foreach x pb1
    
32.     (setq p1(nth in pb)in(1+ in))
    
33.     (#m_dim 32 a "" p0 p1 x "dim" -1)
    
34.   )
    
35. )
    

<br /> (defun #m_dim (d70 d50 d1 p10 p13 p14 lay color / en000)<br />   ;d70线性32对齐33; p10基点 p13第一点 p14第二点 d1强制长度值<br />   ;(#m_dim 32 0 "" p10 p13 p14 "dim" -1)<br />   ;(#m_dim 32 0 "" '(-3000 30000 0.0) '(-498.081 33511.0 0.0) '(-3198.08 33511.0 0.0) "dim" -1)<br />   (setq        en000 (list<br />               (cons 0 "DIMENSION")<br />               (cons 100 "AcDbEntity")<br />               (cons 8 lay)<br />               (cons 100 "AcDbDimension")<br />               (cons 10 p10)<br />               '(11 0 0 0)<br />               (cons 70 d70)<br />               (cons 1 d1)<br />               (cons 100 "AcDbAlignedDimension")<br />               (cons 13 p13)<br />               (cons 14 p14)<br />               (cons 50 d50)<br />             )<br />   )<br />   (if (= (logand d70 5)0)<br />     (setq en000(append en000 (list '(100 . "AcDbRotatedDimension")))))<br />   (if (/= -1 color) (setq en000 (append en000 (list (cons 62 color)))))<br />   (if (= nil (entmake en000)) (princ "\n制造 dim 实体失败.")  )<br /> )<br /> <br /> (defun cy_dim_pb(pb p0 a)   ;;;点表线性标注<br />   (setq p1(car pb)pb1(cdr pb)<br />         in 0)<br />   (foreach x pb1<br />     (setq p1(nth in pb)in(1+ in))<br />     (#m_dim 32 a "" p0 p1 x "dim" -1)<br />   )<br /> )<br />

aeo

天正的两点标注不是很好吗?
先画出平行线,拉一下就出来了.编一下不会比你的复杂.
你的数字变了,还要重写.