[原创]线换向程序

lockmyeye 发表于 2004-2-8 21:24:00

;;;线换向
(DEFUN c:fx (/ acoords ename ename1 etype1 npts num1 pts pt_end pt_start ss1 vobj1)
   (SETQ ss1 (SSGET '((0 . "LINE,MLINE,SPLINE,POLYLINE,LWPOLYLINE"))))
   (IF (= 'ename (TYPE ss1))
            (SETQ ss1 (SSADD ename))
   )
   (SETQ num1 0)
   (REPEAT (IF ss1
                           (SSLENGTH ss1)
                           0
                  )
            (SETQ ename1 (SSNAME ss1 num1)
                        vobj1 (VLAX-ENAME->VLA-OBJECT ename1)
                        etype1 (CDR (ASSOC '0 (ENTGET ename1)))
                        num1 (1+ num1)
            )
            (COND
                  ;;LINE：调换首尾点
                  ((= "LINE" etype1)
                     (SETQ pt_start (VLA-GET-STARTPOINT vobj1)
                                 pt_end (VLA-GET-ENDPOINT vobj1)
                     )
                     (IF (OR (VLA-PUT-STARTPOINT vobj1 pt_end) (VLA-PUT-ENDPOINT vobj1 pt_start))
                              (*error* "不能更新对象数据。")
                     )
                  )
                  ;;SPLIN：调用Reverse反向
                  ((= "SPLINE" etype1)
                     (VLA-REVERSE vobj1)
                  )
                  ;;POLYLINE,LWPOLYLINE:坐标对调
                  ((WCMATCH etype1 "MLINE,POLYLINE,LWPOLYLINE")
                     (SETQ acoords (VLAX-VARIANT-VALUE (VLA-GET-COORDINATES vobj1))
                                 pts       (IF (> (VLAX-SAFEARRAY-GET-U-BOUND acoords 1) (VLAX-SAFEARRAY-GET-L-BOUND acoords 1))
                                                         (VLAX-SAFEARRAY->LIST acoords)
                                                )
                                 npts    (LIST)
                     )
                     (IF (= "LWPOLYLINE" etype1)
                              (WHILE pts
                                    (SETQ npts (CONS (CAR pts) (CONS (CADR pts) npts))
                                                pts (CDDR pts)
                                    )
                              )
                              (WHILE pts
                                    (SETQ npts (CONS (CAR pts) (CONS (CADR pts) (CONS (CADDR pts) npts)))
                                                pts (CDDDR pts)
                                    )
                              )
                     ) ;_对调坐标
                     (IF (VLA-PUT-COORDINATES vobj1 (VLAX-SAFEARRAY-FILL acoords npts))
                              (*error* "不能更新对象数据。")
                     )
                  )
            )
            (VLA-UPDATE vobj1)
   )
   (PRINC)
)对同一POLYLINE使用VLA-GET-COORDINATES后，不能用PEDIT改变拟合状态，否则再用VLA-GET-COORDINATES就会出现“Automation 错误。未提供说明。”不知大家有何良策？

无痕发表于 2004-2-9 02:28:00

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

BDYCAD 发表于 2004-2-9 10:33:00

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

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

龙龙仔 发表于 2004-2-9 12:39:00

;;可有判断顺时针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 <?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-com:office:smarttags" /><st1:place>N Q1</st1:place>)

 (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 发表于 2006-4-27 16:33:00

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

页: [1]

明经CAD社区's Archiver

[原创]线换向程序