[编程申请]：这个程序有问题！进来看看！

xbaron

;;;一条线和多条线交点(表)
(defun c:gxjj ()
  (CMDLA0)
  (princ "\n选择第一条线 : ")
  (setq        s0 (ssget '((0 . "*LINE,LWPOLYLINE,ARC,CIRCLE")))
        S0 (ssname s0 0)
  )
  (princ "\n选择其它的线 : ")
  (setq        ss (ssget '((0 . "*LINE,LWPOLYLINE,ARC,CIRCLE")))
        i  0
  )
  (setq s1 (ssname ss 0)
        pt0 (xyp-get-Inters s0 s1 0)
        ptn '())
  (setq        pt1 (getpoint "\n左上角: ")
        ww  (UDIST 1 "" "\n宽度" ww pt1)
        hh  (UDIST 1 "" "\n字高" hh pt1)
        pt2 (polar pt1 0 ww)
        pt3 (polar pt2 (* pi 1.5) (* hh 2))
        pt4 (polar pt1 (* pi 1.5) (* hh 2))
  )  
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (command "pline" pt2 pt1 pt4 pt3 "")
    (setq ptn (xyp-get-Inters s0 s1 0)
          dist (distance ptn pt0)
          pt0 ptn
    )
    (command "text"
           "m"
           (inters pt1 pt3 pt2 pt4)
           hh
           0
           dist
    )
    (setq  pt1   pt4
           pt2   pt3
           pt4   (polar pt1 (* pi 1.5) (* hh 2))
           pt3   (polar pt2 (* pi 1.5) (* hh 2))
    )  
  (CMDLA1)
  )

总是说二维/三维参数类型有错误

是不是xyp-get-Inters 函数生成的是点集 distance数据类型不支持？

高手帮忙！换句话说怎么把关联表中的表数据提取出来 我用car也不行！~

xyp1964

2. [FONT=courier new]
   
3. ;;;一条线和多条线交点(表)
   
4. (defun c:test256 ()
   
5.   (princ "\n选择第一条线 : ")
   
6.   (setq        s0 (ssget '((0 . "*LINE,ARC,CIRCLE")))
   
7.         S0 (ssname s0 0)
   
8.   )
   
9.   (princ "\n选择其它的线 : ")
   
10.   (setq        ss (ssget '((0 . "*LINE,ARC,CIRCLE")))
    
11.         i  -1
    
12.   )
    
13.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
14.     (setq pt0 (xyp-get-Inters s0 s1 0)
    
15.           ptn (append ptn pt0)
    
16.     )
    
17.   )
    
18.   ptn
    
19. )[/FONT]

[FONT=courier new]<br /> ;;;一条线和多条线交点(表)<br /> (defun c:test256 ()<br />   (princ "\n选择第一条线 : ")<br />   (setq        s0 (ssget '((0 . "*LINE,ARC,CIRCLE")))<br />         S0 (ssname s0 0)<br />   )<br />   (princ "\n选择其它的线 : ")<br />   (setq        ss (ssget '((0 . "*LINE,ARC,CIRCLE")))<br />         i  -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq pt0 (xyp-get-Inters s0 s1 0)<br />           ptn (append ptn pt0)<br />     )<br />   )<br />   ptn<br /> )[/FONT]

xyp1964

2. [FONT=courier new];;;一条线和多条线的交点线长(表)
   
3. (defun c:test ()
   
4.   (cmdlasc0)
   
5.   (princ "\n选择第一条线 : ")
   
6.   (if (and (setq s1 (car (entsel "\n选择第一条线 : ")))
   
7.            (member (xyp-get-dxf 0 s1)
   
8.                    '("LINE"           "LWPOLYLINE"         "POLYLINE"
   
9.                      "ARC"           "CIRCLE"         "ELLIPSE"
   
10.                     )
    
11.            )
    
12.       )
    
13.     (setq ptn (xyp-get-CurveIntersLeng s1 0))
    
14.   )
    
15.   (if (setq pt0 (getpoint "\n标注基点(左上角): "))
    
16.     (foreach pt        ptn
    
17.       (setq pt1        (car pt)
    
18.             zb        (strcat        (rtos (car pt1) 2 3)
    
19.                         " "
    
20.                         (rtos (cadr pt1) 2 3)
    
21.                         " "
    
22.                         (rtos (caddr pt1) 2 3)
    
23.                 )
    
24.             l1        (rtos (cdr pt) 2 3)
    
25.       )
    
26.       (xyp-MkLaco "坐标" 1)
    
27.       (xyp-text 4 pt0 zb)
    
28.       (xyp-MkLaco "线长" 4)
    
29.       (xyp-text 4 (polar pt0 0 (* sc 6000)) l1)
    
30.       (setq pt0 (xyp-get-Pt2XYZ pt0 0 (* sc -500) 0))
    
31.     )
    
32.   )
    
33.   (princ "\n交点线长(表): ")
    
34.   (princ ptn)
    
35.   (cmdla1)
    
36. )[/FONT]

[FONT=courier new];;;一条线和多条线的交点线长(表)<br /> (defun c:test ()<br />   (cmdlasc0)<br />   (princ "\n选择第一条线 : ")<br />   (if (and (setq s1 (car (entsel "\n选择第一条线 : ")))<br />            (member (xyp-get-dxf 0 s1)<br />                    '("LINE"           "LWPOLYLINE"         "POLYLINE"<br />                      "ARC"           "CIRCLE"         "ELLIPSE"<br />                     )<br />            )<br />       )<br />     (setq ptn (xyp-get-CurveIntersLeng s1 0))<br />   )<br />   (if (setq pt0 (getpoint "\n标注基点(左上角): "))<br />     (foreach pt        ptn<br />       (setq pt1        (car pt)<br />             zb        (strcat        (rtos (car pt1) 2 3)<br />                         " "<br />                         (rtos (cadr pt1) 2 3)<br />                         " "<br />                         (rtos (caddr pt1) 2 3)<br />                 )<br />             l1        (rtos (cdr pt) 2 3)<br />       )<br />       (xyp-MkLaco "坐标" 1)<br />       (xyp-text 4 pt0 zb)<br />       (xyp-MkLaco "线长" 4)<br />       (xyp-text 4 (polar pt0 0 (* sc 6000)) l1)<br />       (setq pt0 (xyp-get-Pt2XYZ pt0 0 (* sc -500) 0))<br />     )<br />   )<br />   (princ "\n交点线长(表): ")<br />   (princ ptn)<br />   (cmdla1)<br /> )[/FONT]