[原创]线换向程序

lockmyeye

1. ;;;线换向
2. (DEFUN c:fx (/ acoords ename ename1 etype1 npts num1 pts pt_end pt_start ss1 vobj1)
3.        (SETQ ss1 (SSGET '((0 . "LINE,MLINE,SPLINE,POLYLINE,LWPOLYLINE"))))
4.        (IF (= 'ename (TYPE ss1))
5.                (SETQ ss1 (SSADD ename))
6.        )
7.        (SETQ num1 0)
8.        (REPEAT (IF ss1
9.                                (SSLENGTH ss1)
10.                                0
11.                        )
12.                (SETQ ename1 (SSNAME ss1 num1)
13.                            vobj1   (VLAX-ENAME->VLA-OBJECT ename1)
14.                            etype1 (CDR (ASSOC '0 (ENTGET ename1)))
15.                            num1     (1+ num1)
16.                )
17.                (COND
18.                        ;;LINE：调换首尾点
19.                        ((= "LINE" etype1)
20.                          (SETQ pt_start (VLA-GET-STARTPOINT vobj1)
21.                                      pt_end     (VLA-GET-ENDPOINT vobj1)
22.                          )
23.                          (IF (OR (VLA-PUT-STARTPOINT vobj1 pt_end) (VLA-PUT-ENDPOINT vobj1 pt_start))
24.                                  (*error* "不能更新对象数据。")
25.                          )
26.                        )
27.                        ;;SPLIN：调用Reverse反向
28.                        ((= "SPLINE" etype1)
29.                          (VLA-REVERSE vobj1)
30.                        )
31.                        ;;POLYLINE,LWPOLYLINE:坐标对调
32.                        ((WCMATCH etype1 "MLINE,POLYLINE,LWPOLYLINE")
33.                          (SETQ acoords (VLAX-VARIANT-VALUE (VLA-GET-COORDINATES vobj1))
34.                                      pts         (IF (> (VLAX-SAFEARRAY-GET-U-BOUND acoords 1) (VLAX-SAFEARRAY-GET-L-BOUND acoords 1))
35.                                                              (VLAX-SAFEARRAY->LIST acoords)
36.                                                      )
37.                                      npts       (LIST)
38.                          )
39.                          (IF (= "LWPOLYLINE" etype1)
40.                                  (WHILE pts
41.                                          (SETQ npts (CONS (CAR pts) (CONS (CADR pts) npts))
42.                                                      pts   (CDDR pts)
43.                                          )
44.                                  )
45.                                  (WHILE pts
46.                                          (SETQ npts (CONS (CAR pts) (CONS (CADR pts) (CONS (CADDR pts) npts)))
47.                                                      pts   (CDDDR pts)
48.                                          )
49.                                  )
50.                          ) ;_对调坐标
51.                          (IF (VLA-PUT-COORDINATES vobj1 (VLAX-SAFEARRAY-FILL acoords npts))
52.                                  (*error* "不能更新对象数据。")
53.                          )
54.                        )
55.                )
56.                (VLA-UPDATE vobj1)
57.        )
58.        (PRINC)
59. )

复制代码

对同一POLYLINE使用VLA-GET-COORDINATES后，不能用PEDIT改变拟合状态，否则再用VLA-GET-COORDINATES就会出现“Automation 错误。未提供说明。”不知大家有何良策？

无痕

对有弧线段的pl线，换向后凸度也变了 ：（

BDYCAD

呵呵. 我下載試用一下先.                 


                                                                                                                                                 哈.         謝樓主. 這個可幫了我一個忙. 我用來完善那個把兩條曲線焊接成一條的LISP.                送朵花以表謝意.

龙龙仔

;;可有判断顺时针OR逆时针方法(FOR SPLINE,LWPOLYLINE,POLYLINE)

;;By LUCAS(龙龙仔)

;;线换向程序

;;FOR LWPOLYLINE ONLY

(defun C:TEST (/ ENT ENT1 Q Q1 Q3 Q4 N)

(setq ENT (entget (setq ENT1 (car (entsel)))))

(setq Q (reverse (member (assoc 39 (reverse ENT)) (reverse ENT))))

(setq Q1 (member (assoc 10 ENT) ENT))

(setq N 0

Q3 NIL

)

(repeat (/ (- (length Q1) 1) 4)

(setq Q3 (append Q3

(list (nth N Q1)

(cons 42 (* -1 (cdr (nth (+ N 3) Q1))))

(cons 41 (cdr (nth (+ N 1) Q1)))

(cons 40 (cdr (nth (+ N 2) Q1)))

)

)

)

(setq N (+ N 4))

)

(setq Q3 (reverse Q3))

(entmake (append Q

(member (assoc 10 Q3) Q3)

(list (nth 0 Q3))

(list (nth 1 Q3))

(list (nth 2 Q3))

(list (last Q1))

)

)

(entdel ENT1)

(princ)

)

tjztsh

奇怪，(龙龙仔)的对于拟合后的换向后原来的线条没有了，对于没有拟合还正常。