Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
FutureX

Nhờ sửa lisp xuất toạ độ

Các bài được khuyến nghị

Chào cả nhà!

Mình có tải trên diễn đàn được lisp xuất toạ độ của polyline ra file text. Nhưng chưa thật sự như ý muốn nên muốn nhờ mọi người sửa giúp!

Cụ thể: ví dụ mình có polyline gồm 4 điểm góc, mình muốn lisp xuất toạ độ ra thành 5 dòng toạ độ như sau:

Quote

toạ độ điểm 1

toạ độ điểm 2

toạ độ điểm 3

toạ độ điểm 4 

toạ độ điểm 1

 

Hiện lisp chỉ xuất toạ độ ra thành 4 dòng toạ độ như sau:

Quote

toạ độ điểm 1

toạ độ điểm 2

toạ độ điểm 3

toạ độ điểm 4 

 

Đính kèm lisp bên dưới ạ:

Quote

 

; ----------------------------------------------------------------------

(defun c:XX ()
  (setq sset (ssget '((-4 . "<OR")(0 . "POINT")
                      (0 . "LWPOLYLINE")(-4 . "OR>"))))
  (if sset
    (progn
      (setq itm 0 num (sslength sset))
      (setq fn (getfiled "Point Export File" "" "txt" 1))
      (if (/= fn nil)
        (progn
          (setq fh (open fn "w"))
          (while (< itm num)
            (setq hnd (ssname sset itm))
            (setq ent (entget hnd))
            (setq obj (cdr (assoc 0 ent)))
            (cond
              ((= obj "POINT")
                (setq pnt (cdr (assoc 10 ent)))
                (princ (strcat (rtos (car pnt) 2 2) " "
                               (rtos (cadr pnt) 2 2) " "
                               (rtos (caddr pnt) 2 2)) fh)
                (princ "\n" fh)
              )
              ((= obj "LWPOLYLINE")
                (if (= (cdr (assoc 38 ent)) nil)
                  (setq elv 0.0)
                  (setq elv (cdr (assoc 38 ent)))
                )
                (foreach rec ent
                  (if (= (car rec) 10)
                    (progn
                      (setq pnt (cdr rec))
                      (princ (strcat (rtos (cadr pnt) 2 4) " "
                                     (rtos (car pnt) 2 4)) fh)
                      (princ "\n" fh)
                    )
                  )
                )
              )
              (t nil)
            )
            (setq itm (1+ itm))
          )
          (close fh)
        )
      )
    )
  )
  (princ)
)

(princ "\nPoint Export loaded, type PTEXPORT to run.")
(princ)

Cảm ơn nhiều!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Đây bạn, cái này chắc dễ quá chẳng ai quan tâm làm dùm.

(defun c:XX ()
  (setq sset (ssget '((-4 . "<OR")(0 . "POINT")
                      (0 . "LWPOLYLINE")(-4 . "OR>"))))
  (if sset
    (progn
      (setq itm 0 num (sslength sset))
      (setq fn (getfiled "Point Export File" "" "txt" 1))
      (if (/= fn nil)
        (progn
          (setq fh (open fn "w"))
          (while (< itm num)
            (setq hnd (ssname sset itm))
            (setq ent (entget hnd))
            (setq obj (cdr (assoc 0 ent)))
            (cond
              ((= obj "POINT")
                (setq pnt (cdr (assoc 10 ent)))
                (princ (strcat (rtos (car pnt) 2 2) " "
                               (rtos (cadr pnt) 2 2) " "
                               (rtos (caddr pnt) 2 2)) fh)
                (princ "\n" fh)
              )
              ((= obj "LWPOLYLINE")
                (if (= (cdr (assoc 38 ent)) nil)
                  (setq elv 0.0)
                  (setq elv (cdr (assoc 38 ent)))
                ) 
                                (setq n 0 nn nil)
                (foreach rec ent
                  (if (= (car rec) 10)
                    (progn
                      (setq pnt (cdr rec))                                            
                      (princ (setq n0 (strcat (rtos (cadr pnt) 2 4) " " (rtos (car pnt) 2 4))) fh)
                                            (if (= n 0)    (setq nn n0 n 1))
                      (princ "\n" fh)                                                                        
                    )
                  )
                )
                                 (if nn (princ nn fh))
                                 (princ "\n" fh)
              )
              (t nil)
            )
            (setq itm (1+ itm))
          )
          (close fh)
        )
      )
    )
  )
  (princ)
)

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
18 giờ trước, alisp đã nói:

Đây bạn, cái này chắc dễ quá chẳng ai quan tâm làm dùm.

 

Cảm ơn bạn rất nhiều!

Lisp chạy ngon lành rồi.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×