Đưa bình đồ dạng đường đồng mức về bình đồ dạng cao độ

[Đưa bình đồ dạng đường đồng mức về bình đồ dạng cao độ]

 

Hề hề hề,

1/- Lỗi codebox của diễn đàn, mình không biết cách sửa.

2/- Bạn đã làm đúng. Tuy nhiên đây là code cũ chưa chỉnh sửa. Bởi vậy bạn nên làm tương tự với code mới và test với bản vẽ phù hợp.

3/- Lisp đã chạy hoàn tất chứ không hề mắc mứu chi. Tuy nhiên nó chả ra cái gì vì có thể bạn đã sử dụng bản vẽ để test chưa phù hợp với lisp.

hãy lưu ý các điểm sau đây khi sử dụng lisp này:

1/- Đường dẫn phải là một LWpolyline (vẽ bằng lệnh pline) và phải cắt lần lượt các đường đồng mức theo một chiều lên hay xuống và chỉ cắt mỗi đường đồng mức tại một điểm duy nhất. Do vậy người dùng phải vẽ đường dẫn này cho phù hợp chứ không thể vẽ tùy tiện.

2/- Các đường đồng mức trên bản vẽ phải cùng một màu số 30. (màu này là do mình viết dựa trên bản vẽ của chủ thớt gửi, người dùng khác có thể thay đổi lại trong code cho phù hợp với bản vẽ sử dụng)

3/- Do sử dụng lệnh measure nên độ dài của đường đồng mức phải lớn hơn 200 là khoảng cách giữa các điểm chia trên đường đồng mức. Nếu không sẽ có lỗi. Điều này đã được khắc phục trong code mới chỉnh sửa trong bài post #14 của topic này.

4/- Khi sử dụng lsp phải chắc chắn trên bản vẽ đã có block thuộc tính mang tên CD1 có cấu trúc giống như block mẫu mình đã post trong bài #14 nói trên.

5/- Nếu lười tạo block thuộc tính cd1 có thể sử dụng code bên dưới đây với lưu ý bổ sung là các đường đồng mức phải nằm trên một trong 3 layer sau: 1, 2, 5.

 

(defun c:gcddm ( / pl plst ssdml cdmax chcd i els ssp cdt p0 ssp0)

(vl-load-com)

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

(command "undo" "be")

(setq pl (car (entsel "\n Chon duong dan"))

          plst (acet-geom-vertex-list pl ) )

(if (not (tblsearch "block" "cd1"))

    (atbmk "cd1")

)

 

(setq ssdml (acet-ss-to-list (ssget "f" plst (list (cons 0 "lwpolyline") (cons 62 30) (cons 8 "1,2,5")))))

 

(setq cdmax (getreal "\n Nhap cao do bat dau: ")

          chcd (getreal "\n Nhap do chenh cao giua cac duong dong muc: ")

          i 0 )

 (foreach dm ssdml

         (setq els (entget dm)

                  cdt  (+ cdmax (* i chcd))

                  els (subst (cons 38 cdt ) (assoc 38 els) els)

                  els (subst (cons 62 2) (assoc 62 els) els) )

         (entmod els)

         (setq p0 (vlax-curve-getpointatdist dm 200))

         (if p0

             (progn

                   (command "measure" dm   200)

                   (setq ssp0 (ssget "p"))

                   (setq ssp (acet-ss-to-list ssp0))         

                   (foreach pt ssp

                        (command "insert" "cd1" (cdr (assoc 10 (entget pt))) 1 1 0 (rtos cdt 2 0) )

                   )

              )

              (command "insert" "cd1" (vlax-curve-getstartpoint dm) 1 1 0 (rtos cdt 2 0) )

         )

         (setq i (1+ i)  )

)

(command "erase" pl "")

(command "undo" "e")

(setvar "osmode" oldos)

(princ)

)

 

;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun atbmk ( bln / )

;;;(setq bln (getstring "\n Nhap ten block: "))

(if (not (tblsearch "block" bln))

(progn

       (command "attdef" "" (getstring "\n Nhap att tag: ") (getstring T "\n Nhap dong nhac: ") 

                                     (getstring "\n Nhap gia tri mac dinh: ")  "J" "mc" (setq p0 (getpoint "\n Nhap diem chuan")) 0 )

       (command "scale" (entlast) "" p0 50)

       (command "block" bln p0 (entlast) "")

)

)

)

       

 

 

Hề hề hề,

1/- Lỗi codebox của diễn đàn, mình không biết cách sửa.

2/- Bạn đã làm đúng. Tuy nhiên đây là code cũ chưa chỉnh sửa. Bởi vậy bạn nên làm tương tự với code mới và test với bản vẽ phù hợp.

3/- Lisp đã chạy hoàn tất chứ không hề mắc mứu chi. Tuy nhiên nó chả ra cái gì vì có thể bạn đã sử dụng bản vẽ để test chưa phù hợp với lisp.

hãy lưu ý các điểm sau đây khi sử dụng lisp này:

1/- Đường dẫn phải là một LWpolyline (vẽ bằng lệnh pline) và phải cắt lần lượt các đường đồng mức theo một chiều lên hay xuống và chỉ cắt mỗi đường đồng mức tại một điểm duy nhất. Do vậy người dùng phải vẽ đường dẫn này cho phù hợp chứ không thể vẽ tùy tiện.

2/- Các đường đồng mức trên bản vẽ phải cùng một màu số 30. (màu này là do mình viết dựa trên bản vẽ của chủ thớt gửi, người dùng khác có thể thay đổi lại trong code cho phù hợp với bản vẽ sử dụng)

3/- Do sử dụng lệnh measure nên độ dài của đường đồng mức phải lớn hơn 200 là khoảng cách giữa các điểm chia trên đường đồng mức. Nếu không sẽ có lỗi. Điều này đã được khắc phục trong code mới chỉnh sửa trong bài post #14 của topic này.

4/- Khi sử dụng lsp phải chắc chắn trên bản vẽ đã có block thuộc tính mang tên CD1 có cấu trúc giống như block mẫu mình đã post trong bài #14 nói trên.

5/- Nếu lười tạo block thuộc tính cd1 có thể sử dụng code bên dưới đây với lưu ý bổ sung là các đường đồng mức phải nằm trên một trong 3 layer sau: 1, 2, 5.

 

(defun c:gcddm ( / pl plst ssdml cdmax chcd i els ssp cdt p0 ssp0)

(vl-load-com)

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

(command "undo" "be")

(setq pl (car (entsel "\n Chon duong dan"))

          plst (acet-geom-vertex-list pl ) )

(if (not (tblsearch "block" "cd1"))

    (atbmk "cd1")

)

 

(setq ssdml (acet-ss-to-list (ssget "f" plst (list (cons 0 "lwpolyline") (cons 62 30) (cons 8 "1,2,5")))))

 

(setq cdmax (getreal "\n Nhap cao do bat dau: ")

          chcd (getreal "\n Nhap do chenh cao giua cac duong dong muc: ")

          i 0 )

 (foreach dm ssdml

         (setq els (entget dm)

                  cdt  (+ cdmax (* i chcd))

                  els (subst (cons 38 cdt ) (assoc 38 els) els)

                  els (subst (cons 62 2) (assoc 62 els) els) )

         (entmod els)

         (setq p0 (vlax-curve-getpointatdist dm 200))

         (if p0

             (progn

                   (command "measure" dm   200)

                   (setq ssp0 (ssget "p"))

                   (setq ssp (acet-ss-to-list ssp0))         

                   (foreach pt ssp

                        (command "insert" "cd1" (cdr (assoc 10 (entget pt))) 1 1 0 (rtos cdt 2 0) )

                   )

              )

              (command "insert" "cd1" (vlax-curve-getstartpoint dm) 1 1 0 (rtos cdt 2 0) )

         )

         (setq i (1+ i)  )

)

(command "erase" pl "")

(command "undo" "e")

(setvar "osmode" oldos)

(princ)

)

 

;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun atbmk ( bln / )

;;;(setq bln (getstring "\n Nhap ten block: "))

(if (not (tblsearch "block" bln))

(progn

       (command "attdef" "" (getstring "\n Nhap att tag: ") (getstring T "\n Nhap dong nhac: ") 

                                     (getstring "\n Nhap gia tri mac dinh: ")  "J" "mc" (setq p0 (getpoint "\n Nhap diem chuan")) 0 )

       (command "scale" (entlast) "" p0 50)

       (command "block" bln p0 (entlast) "")

)

)

)

       

Chào bạn.

Mình đã làm y chang như bạn nói chỉ có một điều: đến phút trót đường polyline biến mất và các đường đồng mức vẫn ko có cao độ.

bạn có thể xád định lỗi đó dùm mình ko?

Tks