[求助]：谁帮我解决这个难题

yaker_77

我编的这个程序有时执行正确，有时错误

如果是矩形，就返回长和宽（我不会判断角度）
如果不是矩形，则返回周长和面积

;;;功能：输出面积长度或矩形长宽
(defun c:CS()
(vl-load-com)
(setq modelspace (vla-get-Modelspace
   (vla-get-activeDocument (vlax-get-acad-object))
  )
)
;; 选择多边形
(setq
  ent (ssname (ssget) 0)
  n (vlax-curve-getendParam ent)
)
;; 如果是矩形
(if (= n 4)
;; 计算长宽
  (setq
   di (vlax-curve-getDistAtParam ent 1)
   dj (- (vlax-curve-getDistAtParam ent 2) di)
   text (strcat "L= " (rtos di 2 0) " B= " (rtos dj 2 0))

;; 计算插入点
   p1 (vlax-curve-getstartpoint ent)
   p3 (vlax-curve-getPointAtParam ent 2)
   x1 (car p1)
   y1 (cadr p1)
   x3 (car p3)
   y3 (cadr p3)
   x0 (-
    (/ (+ x1 x3) 2)
    (* (abs(- x1 x3)) 0.3)
   )
   y0 (/ (+ y1 y3) 2)
  )
;; 插入文字
  (if (setq insertpt (list x0 y0 0))
   (if (setq height (/ (+ di dj) 15))
    (vla-addtext modelspace text (vlax-3D-point insertpt) height)
   )
  )
)
;; 如果不是矩形
;;计算周长和面积
(if (> n 4)
  
  (setq
   SL (vlax-curve-getDistAtParam ent n)
   SS (vlax-curve-getarea ent)
   text (strcat "SL= " (rtos (/ SL 1000) 2 2) "M SS= " (rtos (/ SS 1000000) 2 1) "M2")

;; 计算插入点
   p1 (vlax-curve-getstartpoint ent)
   p3 (vlax-curve-getPointAtParam ent 2)
   x1 (car p1)
   y1 (cadr p1)
   x3 (car p3)
   y3 (cadr p3)
   x0 (-
    (/ (+ x1 x3) 2)
    (* (abs(- x1 x3)) 0.3)
   )
   y0 (/ (+ y1 y3) 2)
  )
;; 插入文字
  (if (setq insertpt (list x0 y0 0))
   (if (setq height (/ SL 30))
    (vla-addtext modelspace text (vlax-3D-point insertpt) height)
   )
  )
)
)

Underway

有调试用文件否?

2. 
   
3. (defun c:CS ()
   
4.     (vl-load-com)
   
5.     (setq modelspace
   
6.            (vla-get-Modelspace
   
7.              (vla-get-activeDocument (vlax-get-acad-object))
   
8.            )
   
9.     )
   
10.     (setq ent (ssname (ssget) 0)
    
11.           n   (vlax-curve-getendParam ent)
    
12.     )
    
13.     ;; 如果是矩形
    
14.     (if (= n 4)
    
15.       ;; 计算长宽
    
16.       (progn         ; 加入 progn
    
17.        (setq di   (vlax-curve-getDistAtParam ent 1)
    
18.              dj   (- (vlax-curve-getDistAtParam ent 2) di)
    
19.              text (strcat "L= " (rtos di 2 0) " B= " (rtos dj 2 0))
    
20.   
    
21.              ;; 计算插入点
    
22.              p1   (vlax-curve-getstartpoint ent)
    
23.              p3   (vlax-curve-getPointAtParam ent 2)
    
24.              x1   (car p1)
    
25.              y1   (cadr p1)
    
26.              x3   (car p3)
    
27.              y3   (cadr p3)
    
28.              x0   (-
    
29.                     (/ (+ x1 x3) 2)
    
30.                     (* (abs (- x1 x3)) 0.3)
    
31.                   )
    
32.              y0   (/ (+ y1 y3) 2)
    
33.        )
    
34.         ;; 插入文字
    
35.         (if (setq insertpt (list x0 y0 0))
    
36.           (if (setq height (/ (min di dj) 15))
    
37.             (vla-addtext
    
38.               modelspace
    
39.               text
    
40.               (vlax-3D-point insertpt)
    
41.               height
    
42.             )
    
43.           )
    
44.         )
    
45.       )
    
46.       ;; 如果不是矩形
    
47.       ;;计算周长和面积
    
48.       (progn         ; 加入 progn
    
49.        (setq SL   (vlax-curve-getDistAtParam ent (vlax-curve-getendParam ent))
    
50.              SS   (vlax-curve-getarea ent)
    
51.              text (strcat "SL= "
    
52.                           (rtos (/ SL 1000) 2 2)
    
53.                           "M SS= "
    
54.                           (rtos (/ SS 1000000) 2 1)
    
55.                           "M2"
    
56.                   )
    
57.   
    
58.              ;; 计算插入点
    
59.              p1   (vlax-curve-getstartpoint ent)
    
60.              p3   (vlax-curve-getPointAtParam ent 2)
    
61.              x1   (car p1)
    
62.              y1   (cadr p1)
    
63.              x3   (car p3)
    
64.              y3   (cadr p3)
    
65.              x0   (-
    
66.                     (/ (+ x1 x3) 2)
    
67.                     (* (abs (- x1 x3)) 0.3)
    
68.                   )
    
69.              y0   (/ (+ y1 y3) 2)
    
70.        )
    
71.         ;; 插入文字
    
72.         (if (setq insertpt (list x0 y0 0))
    
73.           (if (setq height (/ SL 50))
    
74.             (vla-addtext
    
75.               modelspace
    
76.               text
    
77.               (vlax-3D-point insertpt)
    
78.               height
    
79.             )
    
80.           )
    
81.         )
    
82.       )
    
83.     )
    
84. )
    

<br /> (defun c:CS ()<br />     (vl-load-com)<br />     (setq modelspace<br />            (vla-get-Modelspace<br />              (vla-get-activeDocument (vlax-get-acad-object))<br />            )<br />     )<br />     (setq ent (ssname (ssget) 0)<br />           n   (vlax-curve-getendParam ent)<br />     )<br />     ;; 如果是矩形<br />     (if (= n 4)<br />       ;; 计算长宽<br />       (progn         ; 加入 progn<br />        (setq di   (vlax-curve-getDistAtParam ent 1)<br />              dj   (- (vlax-curve-getDistAtParam ent 2) di)<br />              text (strcat "L= " (rtos di 2 0) " B= " (rtos dj 2 0))<br />   <br />              ;; 计算插入点<br />              p1   (vlax-curve-getstartpoint ent)<br />              p3   (vlax-curve-getPointAtParam ent 2)<br />              x1   (car p1)<br />              y1   (cadr p1)<br />              x3   (car p3)<br />              y3   (cadr p3)<br />              x0   (-<br />                     (/ (+ x1 x3) 2)<br />                     (* (abs (- x1 x3)) 0.3)<br />                   )<br />              y0   (/ (+ y1 y3) 2)<br />        )<br />         ;; 插入文字<br />         (if (setq insertpt (list x0 y0 0))<br />           (if (setq height (/ (min di dj) 15))<br />             (vla-addtext<br />               modelspace<br />               text<br />               (vlax-3D-point insertpt)<br />               height<br />             )<br />           )<br />         )<br />       )<br />       ;; 如果不是矩形<br />       ;;计算周长和面积<br />       (progn         ; 加入 progn<br />        (setq SL   (vlax-curve-getDistAtParam ent (vlax-curve-getendParam ent))<br />              SS   (vlax-curve-getarea ent)<br />              text (strcat "SL= "<br />                           (rtos (/ SL 1000) 2 2)<br />                           "M SS= "<br />                           (rtos (/ SS 1000000) 2 1)<br />                           "M2"<br />                   )<br />   <br />              ;; 计算插入点<br />              p1   (vlax-curve-getstartpoint ent)<br />              p3   (vlax-curve-getPointAtParam ent 2)<br />              x1   (car p1)<br />              y1   (cadr p1)<br />              x3   (car p3)<br />              y3   (cadr p3)<br />              x0   (-<br />                     (/ (+ x1 x3) 2)<br />                     (* (abs (- x1 x3)) 0.3)<br />                   )<br />              y0   (/ (+ y1 y3) 2)<br />        )<br />         ;; 插入文字<br />         (if (setq insertpt (list x0 y0 0))<br />           (if (setq height (/ SL 50))<br />             (vla-addtext<br />               modelspace<br />               text<br />               (vlax-3D-point insertpt)<br />               height<br />             )<br />           )<br />         )<br />       )<br />     )<br /> )<br />

yaker_77

好用了 谢谢！