尺寸界线程序，无法运行，请求帮助

尘缘一生

如题，写了个这个，无法运行，请求改动。其中：实体交点函数，取自本坛作品。

1. ;;; -------------------------------------------------------------------------
   
2. (defun c:ccjx (/ ang1 pt1 pt3 pt4 pt5 pt7 pt8 ang e p n spname)
   
3.   (setq spname (car (entsel "\n请选择标注尺寸线:")))
   
4.   (if (= "LINE" (cdr (assoc 0 (entget spname))))
   
5.     (progn
   
6.       (setq pt1 (entget spname))
   
7.       (setq pt3 (cdr (assoc 10 pt1)))
   
8.       (setq pt4 (cdr (assoc 11 pt1)))
   
9.       (setq ang (angle pt3 pt4))
   
10.     )
    
11.   )
    
12.   
    
13.   (if (= "lwpolyline" (cdr (assoc 0 (entget spname))))
    
14.     (progn
    
15.       (setq pt3 (vlax-curve-getstartpoint spname)) ; 对象的起点
    
16.       (setq pt4 (vlax-curve-getendpoint spname)) ; 对象的终点
    
17.       (setq ang (angle pt3 pt4))
    
18.     )
    
19.   )
    
20.   (princ "\n 请选择所有尺寸定界线: ")
    
21.   (setq e (ssget))
    
22.   (setq p (sslength e))
    
23.   (setq n 0)
    
24.   (while (< n p)  
    
25.     (setq pt1 (obj_int spname (ssname e n)))  
    
26.     (setq pt7 (polar pt1 (+ (/ pi 4) ang) 0.71))
    
27.     (setq pt8 (polar pt1 (+ (+ (/ pi 4) ang) pi) 0.71))
    
28.     (command "_.PLINE" "non" pt7 "W" 0.45 0.45 "non" pt8 "")         
    
29.     (setq n (+ n 1))
    
30.   )
    
31. )
    
32. 
    
33. ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
34. ;功能:返回两个对象的所有交点
    
35. ;参数: ent1、ent2 均为ename对象
    
36. (defun obj_int (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
    
37.   (setq ax_ent_1 (vlax-ename->vla-object ent1)
    
38.     ax_ent_2 (vlax-ename->vla-object ent2)
    
39.   )
    
40.   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
    
41.   (setq intpoints (vlax-variant-value intpoints))
    
42.   (setq i 0)
    
43.   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
    
44.     (repeat (/ (+ 1
    
45.                  (- (vlax-safearray-get-u-bound intpoints 1)
    
46.                    (vlax-safearray-get-l-bound intpoints 1)
    
47.                  )
    
48.                )
    
49.               3
    
50.             )
    
51.       (setq points (append points (list (list
    
52.                                           (vlax-safearray-get-element intpoints i)
    
53.                                           (vlax-safearray-get-element intpoints (+ i 1))
    
54.                                           (vlax-safearray-get-element intpoints (+ i 2))
    
55.                                         )))
    
56.       )
    
57.       (setq i (+ 3 i))
    
58.     )
    
59.   )
    
60.   points
    
61. )

;;; -------------------------------------------------------------------------<br /> (defun c:ccjx (/ ang1 pt1 pt3 pt4 pt5 pt7 pt8 ang e p n spname)<br />   (setq spname (car (entsel "\n请选择标注尺寸线:")))<br />   (if (= "LINE" (cdr (assoc 0 (entget spname))))<br />     (progn<br />       (setq pt1 (entget spname))<br />       (setq pt3 (cdr (assoc 10 pt1)))<br />       (setq pt4 (cdr (assoc 11 pt1)))<br />       (setq ang (angle pt3 pt4))<br />     )<br />   )<br />   <br />   (if (= "lwpolyline" (cdr (assoc 0 (entget spname))))<br />     (progn<br />       (setq pt3 (vlax-curve-getstartpoint spname)) ; 对象的起点<br />       (setq pt4 (vlax-curve-getendpoint spname)) ; 对象的终点<br />       (setq ang (angle pt3 pt4))<br />     )<br />   )<br />   (princ "\n 请选择所有尺寸定界线: ")<br />   (setq e (ssget))<br />   (setq p (sslength e))<br />   (setq n 0)<br />   (while (< n p)  <br />     (setq pt1 (obj_int spname (ssname e n)))  <br />     (setq pt7 (polar pt1 (+ (/ pi 4) ang) 0.71))<br />     (setq pt8 (polar pt1 (+ (+ (/ pi 4) ang) pi) 0.71))<br />     (command "_.PLINE" "non" pt7 "W" 0.45 0.45 "non" pt8 "")          <br />     (setq n (+ n 1))<br />   )<br /> )<br /> <br /> ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br /> ;功能:返回两个对象的所有交点<br /> ;参数: ent1、ent2 均为ename对象<br /> (defun obj_int (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)<br />   (setq ax_ent_1 (vlax-ename->vla-object ent1)<br />     ax_ent_2 (vlax-ename->vla-object ent2)<br />   )<br />   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))<br />   (setq intpoints (vlax-variant-value intpoints))<br />   (setq i 0)<br />   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)<br />     (repeat (/ (+ 1<br />                  (- (vlax-safearray-get-u-bound intpoints 1)<br />                    (vlax-safearray-get-l-bound intpoints 1)<br />                  )<br />                )<br />               3<br />             )<br />       (setq points (append points (list (list<br />                                           (vlax-safearray-get-element intpoints i)<br />                                           (vlax-safearray-get-element intpoints (+ i 1))<br />                                           (vlax-safearray-get-element intpoints (+ i 2))<br />                                         )))<br />       )<br />       (setq i (+ 3 i))<br />     )<br />   )<br />   points<br /> )

duotu007

函数obj_int 返回的是个点表
改成(setq pt1 (car (obj_int spname (ssname e n))))

尘缘一生

修改调试成功

1. ;;; ------------------------------------------------------------------------
   
2. (defun c:ccjx (/ pt1 pt3 pt4 ang e p n spname)
   
3.   (setq spname (car (entsel "\n请选择标注尺寸线:")))
   
4.   (if (= "LINE" (cdr (assoc 0 (entget spname))))
   
5.     (progn
   
6.       (setq pt1 (entget spname))
   
7.       (setq pt3 (cdr (assoc 10 pt1)))
   
8.       (setq pt4 (cdr (assoc 11 pt1)))
   
9.       (setq ang (/ (* 180 (angle pt3 pt4)) pi))
   
10.     )
    
11.   )
    
12. 
    
13.   (if (= "LWPOLYLINE" (cdr (assoc 0 (entget spname))))
    
14.     (progn
    
15.       (setq pt3 (vlax-curve-getstartpoint spname)) ; 对象的起点
    
16.       (setq pt4 (vlax-curve-getendpoint spname)) ; 对象的终点
    
17.       (setq ang (/ (* 180 (angle pt3 pt4)) pi))
    
18.     )
    
19.   )
    
20.   (princ "\n 请选择所有尺寸定界线: ")
    
21.   (setq e (ssget))
    
22.   (setq p (sslength e))
    
23.   (setq n 0)
    
24.   (while (< n p)
    
25.     (setq pt1 (car (obj_int spname (ssname e n))))
    
26.     (command "-insert" "_archtick" pt1 1 1 ang)
    
27.     (setq n (+ n 1))
    
28.   )
    
29. )
    
30. 
    
31. ;;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
32. ;;; 功能:返回两个对象的所有交点
    
33. ;;; 参数: ent1、ent2 均为ename对象
    
34. (defun obj_int (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
    
35.   (setq ax_ent_1 (vlax-ename->vla-object ent1)
    
36.   ax_ent_2 (vlax-ename->vla-object ent2)
    
37.   )
    
38.   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
    
39.   (setq intpoints (vlax-variant-value intpoints))
    
40.   (setq i 0)
    
41.   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
    
42.     (repeat (/ (+ 1 (- (vlax-safearray-get-u-bound intpoints 1)
    
43.            (vlax-safearray-get-l-bound intpoints 1)
    
44.         )
    
45.          ) 3
    
46.       )
    
47.       (setq points (append
    
48.          points
    
49.          (list (list (vlax-safearray-get-element intpoints i)
    
50.          (vlax-safearray-get-element intpoints
    
51.                    (+ i 1)
    
52.          ) (vlax-safearray-get-element intpoints
    
53.                      (+ i 2)
    
54.            )
    
55.          )
    
56.          )
    
57.        )
    
58.       )
    
59.       (setq i (+ 3 i))
    
60.     )
    
61.   )
    
62.   points
    
63. )
    

;;; ------------------------------------------------------------------------<br /> (defun c:ccjx (/ pt1 pt3 pt4 ang e p n spname)<br />   (setq spname (car (entsel "\n请选择标注尺寸线:")))<br />   (if (= "LINE" (cdr (assoc 0 (entget spname))))<br />     (progn<br />       (setq pt1 (entget spname))<br />       (setq pt3 (cdr (assoc 10 pt1)))<br />       (setq pt4 (cdr (assoc 11 pt1)))<br />       (setq ang (/ (* 180 (angle pt3 pt4)) pi))<br />     )<br />   )<br /> <br />   (if (= "LWPOLYLINE" (cdr (assoc 0 (entget spname))))<br />     (progn<br />       (setq pt3 (vlax-curve-getstartpoint spname)) ; 对象的起点<br />       (setq pt4 (vlax-curve-getendpoint spname)) ; 对象的终点<br />       (setq ang (/ (* 180 (angle pt3 pt4)) pi))<br />     )<br />   )<br />   (princ "\n 请选择所有尺寸定界线: ")<br />   (setq e (ssget))<br />   (setq p (sslength e))<br />   (setq n 0)<br />   (while (< n p)<br />     (setq pt1 (car (obj_int spname (ssname e n))))<br />     (command "-insert" "_archtick" pt1 1 1 ang)<br />     (setq n (+ n 1))<br />   )<br /> )<br /> <br /> ;;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br /> ;;; 功能:返回两个对象的所有交点<br /> ;;; 参数: ent1、ent2 均为ename对象<br /> (defun obj_int (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)<br />   (setq ax_ent_1 (vlax-ename->vla-object ent1)<br />   ax_ent_2 (vlax-ename->vla-object ent2)<br />   )<br />   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))<br />   (setq intpoints (vlax-variant-value intpoints))<br />   (setq i 0)<br />   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)<br />     (repeat (/ (+ 1 (- (vlax-safearray-get-u-bound intpoints 1)<br />            (vlax-safearray-get-l-bound intpoints 1)<br />         )<br />          ) 3<br />       )<br />       (setq points (append<br />          points<br />          (list (list (vlax-safearray-get-element intpoints i)<br />          (vlax-safearray-get-element intpoints<br />                    (+ i 1)<br />          ) (vlax-safearray-get-element intpoints<br />                      (+ i 2)<br />            )<br />          )<br />          )<br />        )<br />       )<br />       (setq i (+ 3 i))<br />     )<br />   )<br />   points<br /> )<br />