Đến nội dung


Hình ảnh
- - - - -

Nhờ Hoàn Thiện


  • Please log in to reply
8 replies to this topic

#1 phuhvp

phuhvp

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 05 June 2016 - 05:17 PM

http://www.cadviet.c...6/150815_tt.lsp

http://www.cadviet.com/upfiles/6/1508

Chào cả nhà, hiện em có 1 Lisp chỉnh sửa đường tự nhiên trên trắc ngang, cụ thể là lisp sẽ giúp ta ghi ra exl các Khoảng cách và cao độ của 1 đường tự nhiên khi ta thực hiện 2 bước (1 và 2) như sau:

0. (trước khi dùng lệnh ta cần chuyển hệ tọa độ gốc cũ sang hệ mới tại tim đường)

1. Chọn đường tự nhiên

2. Chọn cao độ tim đường

sẽ ra kết quả như em mong muốn.

 

Nhưng ở đây em muốn cải thiện 1 chút là:

    _ khi dùng lệnh (cụ thể là tt) thì ta thêm vào 1 bước ( 0. là thêm lệnh ucs new , để ta pick thêm 1 điểm chọn là gốc hệ tọa độ mới ). mục đích để khỏi phải cứ phải ucs chuyển hệ mỗi lần làm với trắc ngang mới.

    _ Em muốn khi xong lệnh 2 (chọn tim đường) nó sẽ tự tạo 1 file exl hoặc scv và hiện lên cho mình copy thôi, ko cần phải lưu ra file mới như lisp cũ 

 

Kính mong các bác, các chị có rãnh qua giúp em tí, em xin cảm ơn nhiều ạ


  • 0

#2 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 06 June 2016 - 10:15 AM

Như vậy là sửa đổi hoặc bổ sung chứ đâu phải hoàn thiện.???


  • 1

#3 phuhvp

phuhvp

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 06 June 2016 - 10:33 AM

Dà, để em sửa lại tiêu đề.. mong bác thông cảm..

Bác có thể bỏ ra ít công sức giúp em đc ko ạ, cảm ơn bác nhiều :wub:


  • 0

#4 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 06 June 2016 - 10:46 AM

Dà, để em sửa lại tiêu đề.. mong bác thông cảm..

Bác có thể bỏ ra ít công sức giúp em đc ko ạ, cảm ơn bác nhiều :wub:

Hình như cái yêu cầu của bạn mình đã làm rồi, nhưng chủ thớt ở topic đó không yêu cầu, để mình tìm lại trong máy xem sao.


  • 1

#5 phuhvp

phuhvp

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 06 June 2016 - 11:04 AM

Hình như cái yêu cầu của bạn mình đã làm rồi, nhưng chủ thớt ở topic đó không yêu cầu, để mình tìm lại trong máy xem sao.

 

Vậy thì còn gì bằng  :D  

Cảm ơn Bác Mạnh nhiều


  • 0

#6 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 06 June 2016 - 11:14 PM

Lisp đây:

(defun c:tt  (/ pr_pt change-org xuat_kq elv ent lsp lst-l lst-r lsw txt x y sep cpr org)
​(vl-load-com)
 (defun pr_pt  (lst / i txt)
  (setq txt "")
  (repeat (setq i (length lst)) (setq txt (strcat txt (chr (nth (setq i (1- i)) (reverse lst))))))
  txt)
 (defun change-org  (poi / result doc)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-put-activeucs doc
                     (setq result (vla-add (vla-get-usercoordinatesystems doc)
                                           (vlax-3d-point poi)
                                           (vlax-3d-point (polar poi 0 1))
                                           (vlax-3d-point (polar poi (* 0.5 pi) 1))
                                           (pr_pt '(87 111 114 108 100))))))
 (defun xuat_kq  (str lst / filename fn i)
  (setq i 1)
  (setq filename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) (pr_pt '(46 116 120 116))))
  (or (findfile fileName) (progn (setq fn (open fileName (pr_pt '(119)))) (close fn)))
  (setq fn (open fileName (pr_pt '(97))))
  (princ (strcat (pr_pt '(10)) (write-line str fn)))
  (foreach x  lst
   (princ (strcat (pr_pt '(10)) (write-line (strcat (itoa i) sep (car x) sep (cadr x)) fn)))
   (setq i (1+ i)))
  (close fn))
 (setq sep (pr_pt '(9)))
 (if (setq org (getpoint (pr_pt '(71 111 99 32 116 111 97 32 100 111 32 109 111 105 58 32))))
  (progn (change-org org)
         (while (and (setq ent (car
                                (entsel
                                 (pr_pt '(10 67 104 111 110 32 80 108 105 110 101 32 116 114 97 99 32 110 103 97 110 103 58 32)))))
                     (wcmatch (cdr (assoc 0 (entget ent))) (pr_pt '(42 80 79 76 89 76 73 78 69)))
                     (not (redraw ent 3))
                     (setq txt (car (entsel (pr_pt '(10 67 104 111 110 32 84 101 120 116 32 99 97 111 32 100 111 32 116 105 109 32 100 117 111 110 103 58 32)))))
                     (wcmatch (cdr (assoc 0 (entget txt))) (pr_pt '(42 84 69 88 84)))
                     (not (redraw ent 4))
                     (setq elv (distof (cdr (assoc 1 (entget txt))) 2))
                     (setq cpr (pr_pt '(76 105 115 112 32 99 114 101 97 116 101 100 32 66 121 32 81 117 111 99 77 97 110 104 48 52 116 116 45 67 97 100 86 105 101 116 46 99 111 109
                                        33))))
          (setq lsp (acet-geom-vertex-list ent))
          (foreach pt  lsp
           (setq x (car pt)
                 y (+ (cadr pt) elv))
           (cond ((< x 0) (setq lst-l (cons (list (rtos (abs x) 2 2) (rtos y 2 2)) lst-l)))
                 ((> x 0) (setq lst-r (cons (list (rtos x 2 2) (rtos y 2 2)) lst-r)))))
          (xuat_kq (strcat (pr_pt '(10 83 84 84))
                           sep
                           (pr_pt '(75 46 99 97 99 104))
                           sep
                           (pr_pt '(67 97 111 32 100 111 10 66 101 110 32 116 114 97 105 58)))
                   lst-l)
          (xuat_kq (pr_pt '(66 101 110 32 112 104 97 105 58)) (reverse lst-r))
          (setq lst-l nil
                lst-r nil))
         (change-org '(0 0 0))))
 (and cpr (princ cpr) (textscr))
 (and ent (redraw ent 4))
 (princ))

  • 1

#7 phuhvp

phuhvp

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 07 June 2016 - 09:01 AM

 

Lisp đây:


 

Lisp đây:

(defun c:tt  (/ pr_pt change-org xuat_kq elv ent lsp lst-l lst-r lsw txt x y sep cpr org)
​(vl-load-com)
 (defun pr_pt  (lst / i txt)
  (setq txt "")
  (repeat (setq i (length lst)) (setq txt (strcat txt (chr (nth (setq i (1- i)) (reverse lst))))))
  txt)
 (defun change-org  (poi / result doc)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-put-activeucs doc
                     (setq result (vla-add (vla-get-usercoordinatesystems doc)
                                           (vlax-3d-point poi)
                                           (vlax-3d-point (polar poi 0 1))
                                           (vlax-3d-point (polar poi (* 0.5 pi) 1))
                                           (pr_pt '(87 111 114 108 100))))))
 (defun xuat_kq  (str lst / filename fn i)
  (setq i 1)
  (setq filename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) (pr_pt '(46 116 120 116))))
  (or (findfile fileName) (progn (setq fn (open fileName (pr_pt '(119)))) (close fn)))
  (setq fn (open fileName (pr_pt '(97))))
  (princ (strcat (pr_pt '(10)) (write-line str fn)))
  (foreach x  lst
   (princ (strcat (pr_pt '(10)) (write-line (strcat (itoa i) sep (car x) sep (cadr x)) fn)))
   (setq i (1+ i)))
  (close fn))
 (setq sep (pr_pt '(9)))
 (if (setq org (getpoint (pr_pt '(71 111 99 32 116 111 97 32 100 111 32 109 111 105 58 32))))
  (progn (change-org org)
         (while (and (setq ent (car
                                (entsel
                                 (pr_pt '(10 67 104 111 110 32 80 108 105 110 101 32 116 114 97 99 32 110 103 97 110 103 58 32)))))
                     (wcmatch (cdr (assoc 0 (entget ent))) (pr_pt '(42 80 79 76 89 76 73 78 69)))
                     (not (redraw ent 3))
                     (setq txt (car (entsel (pr_pt '(10 67 104 111 110 32 84 101 120 116 32 99 97 111 32 100 111 32 116 105 109 32 100 117 111 110 103 58 32)))))
                     (wcmatch (cdr (assoc 0 (entget txt))) (pr_pt '(42 84 69 88 84)))
                     (not (redraw ent 4))
                     (setq elv (distof (cdr (assoc 1 (entget txt))) 2))
                     (setq cpr (pr_pt '(76 105 115 112 32 99 114 101 97 116 101 100 32 66 121 32 81 117 111 99 77 97 110 104 48 52 116 116 45 67 97 100 86 105 101 116 46 99 111 109
                                        33))))
          (setq lsp (acet-geom-vertex-list ent))
          (foreach pt  lsp
           (setq x (car pt)
                 y (+ (cadr pt) elv))
           (cond ((< x 0) (setq lst-l (cons (list (rtos (abs x) 2 2) (rtos y 2 2)) lst-l)))
                 ((> x 0) (setq lst-r (cons (list (rtos x 2 2) (rtos y 2 2)) lst-r)))))
          (xuat_kq (strcat (pr_pt '(10 83 84 84))
                           sep
                           (pr_pt '(75 46 99 97 99 104))
                           sep
                           (pr_pt '(67 97 111 32 100 111 10 66 101 110 32 116 114 97 105 58)))
                   lst-l)
          (xuat_kq (pr_pt '(66 101 110 32 112 104 97 105 58)) (reverse lst-r))
          (setq lst-l nil
                lst-r nil))
         (change-org '(0 0 0))))
 (and cpr (princ cpr) (textscr))
 (and ent (redraw ent 4))
 (princ))

 

 

 

Trước hết cảm ơn Bác Mạnh đã giúp đỡ em

Nhưng em test vẫn còn 2 vấn đề như sau:

 1. Khi em dùng hết lệnh và kết thúc lệnh = dấu cách hoặc enter thì nó lại xuất hiện thêm bảng F2 ( lại phải tắt đi mỗi lần làm cái Tn khác)  còn nếu em dùng Esc để kết thúc thì nó vẫn hiện kết quả đúng nhưng lệnh lần sau lại không còn chính xác nữa.

 2. Em muốn xuất ra file exl (.xls) thì phải sửa như thế nào ạ

 3. Khi xuất ra Dòng nào có Khoảng Cách = 0 (cao độ tại tim cọc)  thì mình xóa luôn, không hiện thị được ko ạ

( Em chỉ muốn như lsp cũ em đã gửi ở đầu bài và thêm vào 1 bước chọn gốc tọa độ mới thôi ạ )

 

THÂN


  • 0

#8 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 07 June 2016 - 09:48 AM

Trong thư mục chứa file dwg có file txt cùng tên (có thể mở được bằng excel), nếu không muốn bật (F2) thì xóa cái này (textscr) , ở cuối lsp.


  • 1

#9 phuhvp

phuhvp

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 07 June 2016 - 10:25 AM

Trong thư mục chứa file dwg có file txt cùng tên (có thể mở được bằng excel), nếu không muốn bật (F2) thì xóa cái này (textscr) , ở cuối lsp.

OK bác quá tuyệt vời ạ


  • 0