[编程申请]：多条多义线字段长度按DX的部分程序又自己瞎写了一个，还是有错！请DX看看

bluesky1000

代码如下：
(defun c:pljl1 (/ ll)
  (setvar "cmdecho" 0)
  (setq ffn (getfiled "选取文件" "" "doc" 1))
  (setq ff (open ffn "w"))
  (close ff)
  (princ "\n选择多义线")
  (setq ss (ssget))
  (setq i 0)
  (setvar "pdmode" 33)
  (repeat (sslength ss)
  (setq ssn (ssname ss i))  
  (setq a (car (entsel ssn)))
  (setq num (cdr (assoc 90 (entget a))) n 1)
  (while (< n num)
    (setq l (- (vlax-curve-getDistAtParam a n)
               (vlax-curve-getDistAtParam a (1- n))))
    (princ l ff)
    (princ "\n" ff)  
  )
  (setq i (1+ i))
  )
  (close ff)
)

LUCAS

2. 
   
3. ;;多條多義線(not closed)字段長度按DX的部分程序又自己瞎寫了一個，
   
4. ;;還是有錯！請DX看看。  
   
5. (defun C:PLJL1 (/ LL)
   
6.   (setvar "cmdecho" 0)
   
7.   (setq FFN (getfiled "選取文件" "" "txt" 1)) ;
   
8.   (setq FF (open FFN "w"))
   
9.   ;;(close FF)
   
10.   (princ "\n選擇多義線")
    
11.   (setq SS (ssget '((0 . "lwpolyline"))))
    
12.   (setq I 0)
    
13.   ;;(setvar "pdmode" 33)
    
14.   (repeat (sslength SS)
    
15.     (setq SSN (ssname SS I))
    
16.     ;;(setq A (car (entsel SSN)))
    
17.     (setq NUM (cdr (assoc 90 (entget SSN)))
    
18.           N   1
    
19.     )
    
20.     (if        (/= 1 (logand (cdr (assoc 70 (entget SSN))) 1)) ;
    
21.       (progn                                ;
    
22.         (while (< N NUM)
    
23.           (setq        L (- (vlax-curve-getdistatparam SSN N)
    
24.                      (vlax-curve-getdistatparam SSN (1- N))
    
25.                   )
    
26.                 N (1+ N)                ;
    
27.           )
    
28.           (princ L FF)
    
29.           (princ " " FF)                ;
    
30.         )
    
31.         (princ "\n" FF)                        ;
    
32.       )                                        ;
    
33.     )                                        ;
    
34.     (setq I (1+ I))
    
35.   )
    
36.   (close FF)
    
37.   (princ)                                ;
    
38. )
    

<br /> ;;多條多義線(not closed)字段長度按DX的部分程序又自己瞎寫了一個，<br /> ;;還是有錯！請DX看看。  <br /> (defun C:PLJL1 (/ LL)<br />   (setvar "cmdecho" 0)<br />   (setq FFN (getfiled "選取文件" "" "txt" 1)) ;<br />   (setq FF (open FFN "w"))<br />   ;;(close FF)<br />   (princ "\n選擇多義線")<br />   (setq SS (ssget '((0 . "lwpolyline"))))<br />   (setq I 0)<br />   ;;(setvar "pdmode" 33)<br />   (repeat (sslength SS)<br />     (setq SSN (ssname SS I))<br />     ;;(setq A (car (entsel SSN)))<br />     (setq NUM (cdr (assoc 90 (entget SSN)))<br />           N   1<br />     )<br />     (if        (/= 1 (logand (cdr (assoc 70 (entget SSN))) 1)) ;<br />       (progn                                ;<br />         (while (< N NUM)<br />           (setq        L (- (vlax-curve-getdistatparam SSN N)<br />                      (vlax-curve-getdistatparam SSN (1- N))<br />                   )<br />                 N (1+ N)                ;<br />           )<br />           (princ L FF)<br />           (princ " " FF)                ;<br />         )<br />         (princ "\n" FF)                        ;<br />       )                                        ;<br />     )                                        ;<br />     (setq I (1+ I))<br />   )<br />   (close FF)<br />   (princ)                                ;<br /> )<br />

bluesky1000

多谢斑竹，太感谢了，可以用了，但是如果能自动直接输出到EXCEL文件中就好了，现在我还得转换。
这是我自己想了大半天的程序，只是每次命令结束后，都会提示“重新生成模型”，程序如下：
(defun c:pljl1 (/ ll)
  (setvar "cmdecho" 0)
  (setq ffn (getfiled "选取文件" "" "doc" 1))
  (setq ff (open ffn "w"))
  (close ff)
  (if (= bl1 nill) (setq bl1 1.0))
  (setq bls (rtos bl1 2 1))
  (setq blss (strcat "\n请输入图纸比例<" bls">:"))
  (setq bl (getreal blss))
  (if (= bl nill) (setq bl bl1 ))
  (setq bl1 bl)
  (princ "\n选择多义线")
  (setq ss (ssget))
  (setq i 0)
  (setvar "pdmode" 33)
(repeat (sslength ss)
  (setq ssn (ssname ss i))  
  (setq a ssn)
  (setq num (cdr (assoc 90 (entget a))) n 1)
  (setq FF (open FFN "a"))
  (while (< n num)
    (setq l (- (vlax-curve-getDistAtParam a n)
               (vlax-curve-getDistAtParam a (1- n)))
          n (1+ n)
          l (/ l bl)
          l (rtos l 2 1)
    )
    (princ l ff)
    (princ " " FF)  
  )
  (princ "\n" ff)
  (close ff)
  (setq i (1+ i))
)
)
这是根据斑竹提供的最新程序所加入图形比例的程序：
(defun c:pljl1 (/ ll)
  (setvar "cmdecho" 0)
  (setq ffn (getfiled "选取文件" "" "doc" 1))
  (setq ff (open ffn "w"))
  (close ff)
  (if (= bl1 nill) (setq bl1 1.0))
  (setq bls (rtos bl1 2 1))
  (setq blss (strcat "\n请输入图纸比例<" bls">:"))
  (setq bl (getreal blss))
  (if (= bl nill) (setq bl bl1 ))
  (setq bl1 bl)
  (princ "\n选择多义线")
  (setq ss (ssget))
  (setq i 0)
  (setvar "pdmode" 33)
(repeat (sslength ss)
  (setq ssn (ssname ss i))  
  (setq a ssn)
  (setq num (cdr (assoc 90 (entget a))) n 1)
  (setq FF (open FFN "a"))
  (while (< n num)
    (setq l (- (vlax-curve-getDistAtParam a n)
               (vlax-curve-getDistAtParam a (1- n)))
          n (1+ n)
          l (/ l bl)
          l (rtos l 2 1)
    )
    (princ l ff)
    (princ " " FF)  
  )
  (princ "\n" ff)
  (close ff)
  (setq i (1+ i))
)
)