Viết lisp theo yêu cầu [phần 2]

[duy782006 1593]

em có 1 đoạn lisp

 

các anh giúp em sửa nó để nó có thể chia đuợc nhiều đuờng giao với 1 đường khác. mình chỉ cần cọn 1 đường làm giao cắt và các đường khác khi cát nó đều bị chia ra tại điểm giao. các anh giúp em nhanh nhé :)

-Bạn hỏi 1 vấn đề ở 2 topic là sai rồi nhé.

-Tìm lisp bẻ đối tượng tại giao điểm của bác giabach mà dùng hỉ.

[phamthanhbinh 3147]

em cho nó nằm theo 1 hàng dọc .

các trắc ngang chỉ nằm trên một hàng dọc thôi .

bác giúp em cái để em ko phải kich thủ công bác à .

tên các cọc nằm trên trắc dọc thì nó nằm ngang .

còn các tên cọc nằm trên trắc ngang thì nó nằm dọc .

để em gửi cái bản vẽ lên là bác biết ngay ấy mà.

bác giúp hộ em cái .

em vừa đi du lịch với công ty mà đến khách sạn là em nhảy vào xem bài bác đã trả lời chưa .

đồng nghiệp nó bảo hâm đi du lịch mà vẫn nghĩ đến công việc.

thôi thì hâm cũng dc .

có chân thành mới dc giúp đỡ mà bác .

thank bác nhiều.

bác viết hộ em cái líp nhé .

bản vẽ em nó đây .

http://www.cadviet.com/upfiles/3/bdtdtnkl_km5km8in__copy.dwg

Hề hề hề,

Nó đây nè. Dùng thử coi nhé. Chú ý rằng khi quét vùng chọn tren trắc dọc, chớ có ôm nhầm mấy em ở khu lý trình vào nghen. Vì các em này có trùng tên, trùng layer và cả trùng màu nữa nên mình chưa loại được. nếu tách được mấy em này qua lớp khác thì tuyệt hảo luôn.

Khi quét vùng chọn các trăc ngang, lưu ý sao cho cái trắc ngang đầu tiên đúng với cái vị trí trên trắc dọc nhé.

(defun c:retn (/ tsl1 tsl2 txt tx t1 t2 t3 elt)
(vl-load-com)
(command "undo" "be")
(alert "\n Chon ten coc tren trac doc theo vung thay the")
(setq tsl1 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8  "TEXTTENCOC")))))
(setq tsl1 (vl-sort tsl1 '(lambda (x y) (< (car (cdr (assoc 11 (entget x)))) (car (cdr (assoc 11 (entget y))))))))
(alert "\n Chon ten coc tren trac ngang theo vung thay the")
(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ENTDAUCO") (cons 1 "Cäc:*")))))
(setq tsl2 (vl-sort tsl2 '(lambda (x y) (> (cadr (cdr (assoc 11 (entget x)))) (cadr (cdr (assoc 11 (entget y))))))))
(foreach txt tsl1
       (setq t1 (cdr (assoc 1 (entget txt))))
       (setq n (vl-position txt tsl1))
       (setq tx (nth n tsl2))
       (if tx
           (progn
               (setq elt (entget tx)
                       t2 (substr (cdr (assoc 1 elt)) 1 4)
                       t3 (strcat t2 " " t1)
                       elt (subst (cons 1 t3) (assoc 1 elt) elt)
               ) 
               (entmod elt)
          )
       )
)
(command "undo" "e")
(princ)
)

Do cái hình trắc ngang trắc dọc của bạn hơi ti hin nên bạn có thể chơi làm nhiều phát cho dễ kiểm hoặc chơi tổng một phát cũng Ok. mà hình như số trắc ngang còn thiếu cũng khơ khớ thì phải.... Chạy phát một thì chỉ tới trắc ngang TC95 là hết trong khi trên trắc dọc có tới quá TC105 lận. hề hề hề, kiểu này khó mà lười lắm........

[nguyentienthanhddksct 6]

bạn có thể hướng dẫn mình kỹ một chút không? Ví dụ các tọa độ mình đã nhập hết vào excel rồi. Đã load lisp xong rồi. Bước tiếp theo là làm những j?

cảm ơn nhiều vì mình không biết nhiều về lisp!

 

 

bạn cho mình hỏi là bạn có các điểm tọa độ muốn đưa lên cad à. nếu là như vậy mình có 1 lisp để triển các điểm tọa độ lên đó.

[nguyentienthanhddksct 6]

em có lisp này mong các bác chỉ giùm: lsp này là ghi tọa độ ra màn hình. nhưng nó lại đánh tên theo thứ tự em đo quy hoach giao thông nên chỉ cần ghi tọa độ ra màn hình không cần tên. các bác bỏ cái tên hộ em cái. thanks!

đây là lsp đó:

My link

[pdle 126]

em có lisp này mong các bác chỉ giùm: lsp này là ghi tọa độ ra màn hình. nhưng nó lại đánh tên theo thứ tự em đo quy hoach giao thông nên chỉ cần ghi tọa độ ra màn hình không cần tên. các bác bỏ cái tên hộ em cái. thanks!

đây là lsp đó:

My link

Của anh đây:

(defun c:xy ( / ts pt1 pt2 px py pxt pyt txtpnt txtpnt1 txtpnt2 algn d alp)

(defun SETERR (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
) ; of If
(setq *error* oer
seterr nil
)
(princ)
) ; of SETERR
(setq oer *error*
*error* seterr
)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE")))

(setq pt1 (getpoint "\nPick First Point:"))
(setq pt2 (getpoint pt1 "\nPick Second Point:"))
(setq px (car pt1))
(setq py (cadr pt1))
;****** real to string
(setq pxt  (rtos px 2 ))
(setq pyt (rtos py 2 ))
(command "dim1" "leader" pt1 pt2 "" pxt)
(setq txtpnt (cdr (assoc 10 (entget (entlast)))))
(setq txtpnt1 (list (car txtpnt)
(- (cadr txtpnt) (* 2.0 ts))
2.0
)
)
(setq d(sqrt (+ (* ts ts) (* 100 100))))
(setq alp(atan (/ ts 100)))
(setq txtpnt2 (polar txtpnt1 alp d))
(command "MTEXT" txtpnt1 txtpnt2 pyt "")
(setq *error* oer
seterr nil
)
(princ)

) 

[nguyentienthanhddksct 6]

Của anh đây:

(defun c:xy ( / ts pt1 pt2 px py pxt pyt txtpnt txtpnt1 txtpnt2 algn d alp)

(defun SETERR (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
) ; of If
(setq *error* oer
seterr nil
)
(princ)
) ; of SETERR
(setq oer *error*
*error* seterr
)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE")))

(setq pt1 (getpoint "\nPick First Point:"))
(setq pt2 (getpoint pt1 "\nPick Second Point:"))
(setq px (car pt1))
(setq py (cadr pt1))
;****** real to string
(setq pxt  (rtos px 2 ))
(setq pyt (rtos py 2 ))
(command "dim1" "leader" pt1 pt2 "" pxt)
(setq txtpnt (cdr (assoc 10 (entget (entlast)))))
(setq txtpnt1 (list (car txtpnt)
(- (cadr txtpnt) (* 2.0 ts))
2.0
)
)
(setq d(sqrt (+ (* ts ts) (* 100 100))))
(setq alp(atan (/ ts 100)))
(setq txtpnt2 (polar txtpnt1 alp d))
(command "MTEXT" txtpnt1 txtpnt2 pyt "")
(setq *error* oer
seterr nil
)
(princ)

) 

 

 

 

 

Trước tiên cám ơn pác pdle nhìu. cái lsp của pác sài cũng được, nhưng lsp này không giống lsp của em. lsp của em khi đánh có hỏi chiều cao text. và có đường line ở giữa tọa độ x,y vậy pác có thể sửa cái lsp của em không vậy chỉ cần bỏ cái tên đi thui. mong pác giúp nhe...

[pdle 126]

Trước tiên cám ơn pác pdle nhìu. cái lsp của pác sài cũng được, nhưng lsp này không giống lsp của em. lsp của em khi đánh có hỏi chiều cao text. và có đường line ở giữa tọa độ x,y vậy pác có thể sửa cái lsp của em không vậy chỉ cần bỏ cái tên đi thui. mong pác giúp nhe...

 

Theo ngu ý của em là có khi nào anh upload nhầm lisp không ạ? Em dùng thử lisp anh upload lên thấy nó có hỏi gì đâu ạ? Chỉ hỏi first point và second point thôi ạ :0

[nguyentienthanhddksct 6]

Theo ngu ý của em là có khi nào anh upload nhầm lisp không ạ? Em dùng thử lisp anh upload lên thấy nó có hỏi gì đâu ạ? Chỉ hỏi first point và second point thôi ạ :0

 

 

sorry pac nnhé hôm qua em ngủ quên mất tiêu. đúng là em up nhầm lsp pác ạ. em up lại pác coi nhé:

My link

[phamthanhbinh 3147]

sorry pac nnhé hôm qua em ngủ quên mất tiêu. đúng là em up nhầm lsp pác ạ. em up lại pác coi nhé:

My link

Hề hề hề,

Bạn có thể tự mình làm được điều này mà.

Này nhé, hãy vô hiệu hóa các dòng code có dính tới cái stt đi là Ok thôi. Cách vô hiệu hóa một dòng code là thêm vào phía trước dòng code đó một hay vài ký tự chấm phẩy ( ; ) bạn ạ.

Trước hết bạn hãy thử thêm vào phía trước dòng code:

stt (append stt (list N))

để thành:

;;;; stt (append stt (list N))

 

Sau đó lưu file lisp lại thành file mới và chạy thử file mới này xem sao nhé. Có gì ta sẽ lại trao đổi tiếp.

Hề hề hề....

[hakhoailang 2]

Hề hề hề,

Nó đây nè. Dùng thử coi nhé. Chú ý rằng khi quét vùng chọn tren trắc dọc, chớ có ôm nhầm mấy em ở khu lý trình vào nghen. Vì các em này có trùng tên, trùng layer và cả trùng màu nữa nên mình chưa loại được. nếu tách được mấy em này qua lớp khác thì tuyệt hảo luôn.

Khi quét vùng chọn các trăc ngang, lưu ý sao cho cái trắc ngang đầu tiên đúng với cái vị trí trên trắc dọc nhé.

(defun c:retn (/ tsl1 tsl2 txt tx t1 t2 t3 elt)
(vl-load-com)
(command "undo" "be")
(alert "\n Chon ten coc tren trac doc theo vung thay the")
(setq tsl1 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8  "TEXTTENCOC")))))
(setq tsl1 (vl-sort tsl1 '(lambda (x y) (< (car (cdr (assoc 11 (entget x)))) (car (cdr (assoc 11 (entget y))))))))
(alert "\n Chon ten coc tren trac ngang theo vung thay the")
(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ENTDAUCO") (cons 1 "Cäc:*")))))
(setq tsl2 (vl-sort tsl2 '(lambda (x y) (> (cadr (cdr (assoc 11 (entget x)))) (cadr (cdr (assoc 11 (entget y))))))))
(foreach txt tsl1
       (setq t1 (cdr (assoc 1 (entget txt))))
       (setq n (vl-position txt tsl1))
       (setq tx (nth n tsl2))
       (if tx
           (progn
               (setq elt (entget tx)
                       t2 (substr (cdr (assoc 1 elt)) 1 4)
                       t3 (strcat t2 " " t1)
                       elt (subst (cons 1 t3) (assoc 1 elt) elt)
               ) 
               (entmod elt)
          )
       )
)
(command "undo" "e")
(princ)
)

Do cái hình trắc ngang trắc dọc của bạn hơi ti hin nên bạn có thể chơi làm nhiều phát cho dễ kiểm hoặc chơi tổng một phát cũng Ok. mà hình như số trắc ngang còn thiếu cũng khơ khớ thì phải.... Chạy phát một thì chỉ tới trắc ngang TC95 là hết trong khi trên trắc dọc có tới quá TC105 lận. hề hề hề, kiểu này khó mà lười lắm........

ko phải đâu bác em cắt nó ngắn đi để nhẹ hơn ấy mà . upload cho dễ thôi.

thank bác để em thử phát

[3d.decor 1]

bác nào viết hộ em cái lisp xoay góc line

có đường line thẳng

pick điểm 1 ( gốc xoay ) pick điểm 2 lấy chiều xoay

dau đó chỉ hướng bằng chuột và gỗ 15 độ

đường line sẽ quay lên 15 đọ

[hakhoailang 2]

Hề hề hề,

Nó đây nè. Dùng thử coi nhé. Chú ý rằng khi quét vùng chọn tren trắc dọc, chớ có ôm nhầm mấy em ở khu lý trình vào nghen. Vì các em này có trùng tên, trùng layer và cả trùng màu nữa nên mình chưa loại được. nếu tách được mấy em này qua lớp khác thì tuyệt hảo luôn.

Khi quét vùng chọn các trăc ngang, lưu ý sao cho cái trắc ngang đầu tiên đúng với cái vị trí trên trắc dọc nhé.

(defun c:retn (/ tsl1 tsl2 txt tx t1 t2 t3 elt)
(vl-load-com)
(command "undo" "be")
(alert "\n Chon ten coc tren trac doc theo vung thay the")
(setq tsl1 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8  "TEXTTENCOC")))))
(setq tsl1 (vl-sort tsl1 '(lambda (x y) (< (car (cdr (assoc 11 (entget x)))) (car (cdr (assoc 11 (entget y))))))))
(alert "\n Chon ten coc tren trac ngang theo vung thay the")
(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ENTDAUCO") (cons 1 "Cäc:*")))))
(setq tsl2 (vl-sort tsl2 '(lambda (x y) (> (cadr (cdr (assoc 11 (entget x)))) (cadr (cdr (assoc 11 (entget y))))))))
(foreach txt tsl1
       (setq t1 (cdr (assoc 1 (entget txt))))
       (setq n (vl-position txt tsl1))
       (setq tx (nth n tsl2))
       (if tx
           (progn
               (setq elt (entget tx)
                       t2 (substr (cdr (assoc 1 elt)) 1 4)
                       t3 (strcat t2 " " t1)
                       elt (subst (cons 1 t3) (assoc 1 elt) elt)
               ) 
               (entmod elt)
          )
       )
)
(command "undo" "e")
(princ)
)

Do cái hình trắc ngang trắc dọc của bạn hơi ti hin nên bạn có thể chơi làm nhiều phát cho dễ kiểm hoặc chơi tổng một phát cũng Ok. mà hình như số trắc ngang còn thiếu cũng khơ khớ thì phải.... Chạy phát một thì chỉ tới trắc ngang TC95 là hết trong khi trên trắc dọc có tới quá TC105 lận. hề hề hề, kiểu này khó mà lười lắm........

bác ơi em quét đối tượng trên trắc dọc thì nó nhận còn các đối tượng tên cọc trên trắc ngang nó lại không nhận bác nhỉ nó báo là Select objects: Specify opposite corner: 0 found, 0 total

bây giờ phải làm thế nào đây bác nhỉ

chọn một hay quét

[phamthanhbinh 3147]

bác ơi em quét đối tượng trên trắc dọc thì nó nhận còn các đối tượng tên cọc trên trắc ngang nó lại không nhận bác nhỉ nó báo là Select objects: Specify opposite corner: 0 found, 0 total

bây giờ phải làm thế nào đây bác nhỉ

Hề hề hề,

Kiểm tra lại xem text tên cọc có phải nằm trên lớp "ENTDAUCO" không nhé và cái font của text có đúng như font trong file bạn đã gửi không. Bởi vì mình tạo bộ lọc text theo lớp và nội dung text để hạn chế bớt số đối tượng ngoại lai làm chậm tốc độ lisp và còn gây nhầm lẫn nữa.

Đó cũng chính là nhược điểm của phương pháp chọn theo phương pháp quét, nhất là với các bản vẽ nhỏ ti hin như của bạn.

Hề hề hề,

Với bản vẽ bạn post lên mình chạy thử thì ngon choét, chả phải khiếu nại gì????

Hề hề hề,

Về cách sửa bạn có thể làm như sau:

1/- Gõ (entget (car (entsel))) trên dòng command và enter. Chọn vào cái text Cọc: ....... trên bản vẽ trắc ngang.

2/- Nhấn F2 để hiện màn hình văn bản của CAD.

3/- Mở file lisp, tìm đến dòng code:

(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ENTDAUCO") (cons 1 "Cäc:*")))))

4/- Mở màn hình CAD copy đoạn text sau trong elist (8. "tênlayer") nghĩa là chỉ copy cái "tênlayer" thoi nhé

5/- Mở màn hình chứa file lisp dán cái text đó vào hàm cons thành (cons 8 "tênlayer")

6/- Mở màn hình CAD copy text trong elist (1 . "têncọc")

7/- Mở màn hình lisp dán text đó vào hàm cons thành (cons 1 "têncọc")

8/- Xóa bớt các ký tự trong "têncọc" chỉ để lại 3 ký tự đầu tiên và thêm ký tự (*) vào để thành (cons 1 "tên*")

9/- save lại file lisp thành tên khác và chạy file lisp này.

 

Hề hề hề, vậy hy vọng là bạn sẽ thỏa mãn và cười tít mắt.

Chúc bạn vui.

[hakhoailang 2]

Hề hề hề,

Kiểm tra lại xem text tên cọc có phải nằm trên lớp "ENTDAUCO" không nhé và cái font của text có đúng như font trong file bạn đã gửi không. Bởi vì mình tạo bộ lọc text theo lớp và nội dung text để hạn chế bớt số đối tượng ngoại lai làm chậm tốc độ lisp và còn gây nhầm lẫn nữa.

Đó cũng chính là nhược điểm của phương pháp chọn theo phương pháp quét, nhất là với các bản vẽ nhỏ ti hin như của bạn.

Hề hề hề,

Với bản vẽ bạn post lên mình chạy thử thì ngon choét, chả phải khiếu nại gì????

Hề hề hề,

Về cách sửa bạn có thể làm như sau:

1/- Gõ (entget (car (entsel))) trên dòng command và enter. Chọn vào cái text Cọc: ....... trên bản vẽ trắc ngang.

2/- Nhấn F2 để hiện màn hình văn bản của CAD.

3/- Mở file lisp, tìm đến dòng code:

(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ENTDAUCO") (cons 1 "Cäc:*")))))

4/- Mở màn hình CAD copy đoạn text sau trong elist (8. "tênlayer") nghĩa là chỉ copy cái "tênlayer" thoi nhé

5/- Mở màn hình chứa file lisp dán cái text đó vào hàm cons thành (cons 8 "tênlayer")

6/- Mở màn hình CAD copy text trong elist (1 . "têncọc")

7/- Mở màn hình lisp dán text đó vào hàm cons thành (cons 1 "têncọc")

8/- Xóa bớt các ký tự trong "têncọc" chỉ để lại 3 ký tự đầu tiên và thêm ký tự (*) vào để thành (cons 1 "tên*")

9/- save lại file lisp thành tên khác và chạy file lisp này.

 

Hề hề hề, vậy hy vọng là bạn sẽ thỏa mãn và cười tít mắt.

Chúc bạn vui.

em dùng cái antxt ẩn hết line rồi dùng layiso sau đó dùng retn rồi quét thôi .bản vẽ thì em vvãn lấy cái gửi lên cho bác đó .có sử cái gì đâu .

nếu ko ẩn line quét hết cả nó có dc ko bác nhỉ hay lại sai.

[hakhoailang 2]

Hề hề hề,

Kiểm tra lại xem text tên cọc có phải nằm trên lớp "ENTDAUCO" không nhé và cái font của text có đúng như font trong file bạn đã gửi không. Bởi vì mình tạo bộ lọc text theo lớp và nội dung text để hạn chế bớt số đối tượng ngoại lai làm chậm tốc độ lisp và còn gây nhầm lẫn nữa.

Đó cũng chính là nhược điểm của phương pháp chọn theo phương pháp quét, nhất là với các bản vẽ nhỏ ti hin như của bạn.

Hề hề hề,

Với bản vẽ bạn post lên mình chạy thử thì ngon choét, chả phải khiếu nại gì????

Hề hề hề,

Về cách sửa bạn có thể làm như sau:

1/- Gõ (entget (car (entsel))) trên dòng command và enter. Chọn vào cái text Cọc: ....... trên bản vẽ trắc ngang.

2/- Nhấn F2 để hiện màn hình văn bản của CAD.

3/- Mở file lisp, tìm đến dòng code:

(setq tsl2 (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "ENTDAUCO") (cons 1 "Cäc:*")))))

4/- Mở màn hình CAD copy đoạn text sau trong elist (8. "tênlayer") nghĩa là chỉ copy cái "tênlayer" thoi nhé

5/- Mở màn hình chứa file lisp dán cái text đó vào hàm cons thành (cons 8 "tênlayer")

6/- Mở màn hình CAD copy text trong elist (1 . "têncọc")

7/- Mở màn hình lisp dán text đó vào hàm cons thành (cons 1 "têncọc")

8/- Xóa bớt các ký tự trong "têncọc" chỉ để lại 3 ký tự đầu tiên và thêm ký tự (*) vào để thành (cons 1 "tên*")

9/- save lại file lisp thành tên khác và chạy file lisp này.

 

Hề hề hề, vậy hy vọng là bạn sẽ thỏa mãn và cười tít mắt.

Chúc bạn vui.

bác ơi lem làm như bác rồi thay vào rồi mà nó báo là 0 cả bác à .

khi em ấn F2 nó như sau

 

Select objects: Specify opposite corner: 0 found, 0 total

 

Select objects: *Cancel*

; error: Function cancelled

 

Command: *Cancel*

 

Command: *Cancel*

 

Command: *Cancel*

 

Command: (entget (car (entsel)))

 

Select object: ((-1 . <Entity name: 7efadac8>) (0 . "TEXT") (330 . <Entity

name: 7ef71cf8>) (5 . "1868A9") (100 . "AcDbEntity") (67 . 0) (410 . "Model")

(8 . "ENTDAUCO") (100 . "AcDbText") (10 43541.3 3782.85 0.0) (40 . 0.6) (1 .

"Cäc:H8") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 1)

(11 43542.9 3782.85 0.0) (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0))

 

em thay cái này vào hàm cons "ENTDAUCO" nhưng rồi cũng bó tay rồi bác .

cuối cungv vẫn chưa tít mắt dc rồi .

bác xem có hướng nào khác ko bác .

thank bác .

[phamthanhbinh 3147]

bác ơi lem làm như bác rồi thay vào rồi mà nó báo là 0 cả bác à .

khi em ấn F2 nó như sau

 

Select objects: Specify opposite corner: 0 found, 0 total

 

Select objects: *Cancel*

; error: Function cancelled

 

Command: *Cancel*

 

Command: *Cancel*

 

Command: *Cancel*

 

Command: (entget (car (entsel)))

 

Select object: ((-1 . <Entity name: 7efadac8>) (0 . "TEXT") (330 . <Entity

name: 7ef71cf8>) (5 . "1868A9") (100 . "AcDbEntity") (67 . 0) (410 . "Model")

(8 . "ENTDAUCO") (100 . "AcDbText") (10 43541.3 3782.85 0.0) (40 . 0.6) (1 .

"Cäc:H8") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 1)

(11 43542.9 3782.85 0.0) (210 0.0 0.0 1.0) (100 . "AcDbText") (73 . 0))

 

em thay cái này vào hàm cons "ENTDAUCO" nhưng rồi cũng bó tay rồi bác .

cuối cungv vẫn chưa tít mắt dc rồi .

bác xem có hướng nào khác ko bác .

thank bác .

Hề hề hề,

Ây da, nếu đúng như cái elist bạn pót này thì chả phải thay thiếc gì sốt. Bạn gửi bản vẽ lên đây mình coi xem nào chứ vô cái lý, bản vẽ bạn gửi mình nó chạy phăm phăm cơ mà.

[nguyentienthanhddksct 6]

Hề hề hề,

Bạn có thể tự mình làm được điều này mà.

Này nhé, hãy vô hiệu hóa các dòng code có dính tới cái stt đi là Ok thôi. Cách vô hiệu hóa một dòng code là thêm vào phía trước dòng code đó một hay vài ký tự chấm phẩy ( ; ) bạn ạ.

Trước hết bạn hãy thử thêm vào phía trước dòng code:

stt (append stt (list N))

để thành:

;;;; stt (append stt (list N))

 

Sau đó lưu file lisp lại thành file mới và chạy thử file mới này xem sao nhé. Có gì ta sẽ lại trao đổi tiếp.

Hề hề hề....

 

:( :( :( huhu em làm theo bác nhưng vẫn chưa được bác ạ. bác xem lại hộ em cái.

[phamthanhbinh 3147]

:( :( :( huhu em làm theo bác nhưng vẫn chưa được bác ạ. bác xem lại hộ em cái.

Hề hề hề,

Vậy chứ nó ra cái chi và không được ở chỗ nào chớ????

Hề hề hề

[ketxu 3000]

bác nào viết hộ em cái lisp xoay góc line

có đường line thẳng

pick điểm 1 ( gốc xoay ) pick điểm 2 lấy chiều xoay

dau đó chỉ hướng bằng chuột và gỗ 15 độ

đường line sẽ quay lên 15 đọ

Ồ, sao nghe giống cái lisp Rotate thế bạn nhỉ ^^

Banj 3d chú ý : post file kèm để minh hoạ ý tưởng!

[nguyentienthanhddksct 6]

Hề hề hề,

Vậy chứ nó ra cái chi và không được ở chỗ nào chớ????

Hề hề hề

 

 

em sửa cái dòng như bác chỉ. vậy mà nó vẫn có số thứ tự như cũ,nó lỳ thật chẳng thay đổi gì cả. thế mới khổ chứ.

em đã sửa thêm trên dòng đó nữa. thằn số thứ tự đã mất nhưng thằng vòng tròn vẫn trơ trơ ra đó bác à. giả quyết cho em cái vòng tròn đó nhé.

[phamthanhbinh 3147]

em sửa cái dòng như bác chỉ. vậy mà nó vẫn có số thứ tự như cũ,nó lỳ thật chẳng thay đổi gì cả. thế mới khổ chứ.

em đã sửa thêm trên dòng đó nữa. thằn số thứ tự đã mất nhưng thằng vòng tròn vẫn trơ trơ ra đó bác à. giả quyết cho em cái vòng tròn đó nhé.

Hề hề hề,

Vậy là bạn sắp thành lisper rồi đó. Ráng lên chút xíu nữa là tới thiên đường thôi mà.

Hề hề hề,...

Bạn xài cái này coi có ưng cái bụng không hè???

Hãy so sánh với cái bạn đã sửa để biết mình đã làm gì và từ đó có thêm kinh nghiệm sửa lisp theo ý mình và trở thành lisper hỉ...

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12225
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td1 (/ diem PT1 PT2 PT3 tapx tapy 
	   x y xx yy h n di kc
	   C PT PTX PTY PTD PTC N
	   p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
 (setq om (getvar "osmode"))
 (setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:"))

(while
 (setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
 (progn
(setq   PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
	PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
	 x (rtos(car diem) 2 4)
		 y (rtos (cadr diem) 2 4)
   tapx (append tapx (list x))
   tapy (append tapy (list y))
	 k (+ 1 k)
	;;; N (strcat "N" (rtos k 2 0))
	;;;stt (append stt (list N))
  );setq
 (setvar "osmode" 0)
 (command "text" "j" "BL" PT1 h 0 x)
 (setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C  (polar PT3 0 (* 1.5 h))
  );setq
(command "text" PT2 h 0 y
	 "pline" diem PT1 PT3 ""
	;;; "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
	;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn   
 );dong while

;tao bang thong ke
 (setq	kc (* 2 di)
	PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
  p1 (list (car PT) (+ (cadr PT)(* 2 h)))
  p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
	  p3 (list (car p1) (+ (cadr p1)(* 2 h)))
	  p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
  p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
  p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
  p33 (list (+ kc (car p22)) (cadr p22))
  L1 (list (+ di (car p3))(cadr p3))
  L2 (list (+ kc (car L1))(cadr L1))
 n (length tapx)
 k 0
);setq
(setvar "osmode" 0)
 (command "line" p1 p2 ""
  ;;; "text" "j" "m" p11 h 0 "STT" 
   "text" "j" "m" p22 h 0 "Täa ®é X" 
   "text" "j" "m" p33 h 0 "Täa ®é Y"
   "line" p3 p4 "")	

 (while (< k n) 
(setq xx (nth k tapx)
  yy (nth k tapy)
;;; tstt(nth k stt)
             )
(command ;;;;; "text" "j" "m" PTD h 0 tstt 
	 "text" "j" "m" PTX h 0 xx 
	 "text" "j" "m" PTY h 0 yy 
	 "line" PT PTC "")	
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
	 PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
 PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
 PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
 PTY (list (+ kc (car PTX)) (cadr PTX))
  k (+ 1 k));setq
 );while
 (if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
	  PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
  L11 (list (+ di (car PT))(cadr PT))
  L22 (list (+ kc (car L11))(cadr L11))
  );setq
);if
(command "line" p3 PT ""
  "line" p4 PTC ""
  "line" L1 L11 ""
  "line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
 (command "Undo" "End")
 (princ)
);DONG toado

[nguyentienthanhddksct 6]

Hề hề hề,

Vậy là bạn sắp thành lisper rồi đó. Ráng lên chút xíu nữa là tới thiên đường thôi mà.

Hề hề hề,...

Bạn xài cái này coi có ưng cái bụng không hè???

Hãy so sánh với cái bạn đã sửa để biết mình đã làm gì và từ đó có thêm kinh nghiệm sửa lisp theo ý mình và trở thành lisper hỉ...

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12225
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td1 (/ diem PT1 PT2 PT3 tapx tapy 
	   x y xx yy h n di kc
	   C PT PTX PTY PTD PTC N
	   p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
 (setq om (getvar "osmode"))
 (setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:"))

(while
 (setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
 (progn
(setq   PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
	PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
	 x (rtos(car diem) 2 4)
		 y (rtos (cadr diem) 2 4)
   tapx (append tapx (list x))
   tapy (append tapy (list y))
	 k (+ 1 k)
	;;; N (strcat "N" (rtos k 2 0))
	;;;stt (append stt (list N))
  );setq
 (setvar "osmode" 0)
 (command "text" "j" "BL" PT1 h 0 x)
 (setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C  (polar PT3 0 (* 1.5 h))
  );setq
(command "text" PT2 h 0 y
	 "pline" diem PT1 PT3 ""
	;;; "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
	;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn   
 );dong while

;tao bang thong ke
 (setq	kc (* 2 di)
	PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
  p1 (list (car PT) (+ (cadr PT)(* 2 h)))
  p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
	  p3 (list (car p1) (+ (cadr p1)(* 2 h)))
	  p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
  p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
  p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
  p33 (list (+ kc (car p22)) (cadr p22))
  L1 (list (+ di (car p3))(cadr p3))
  L2 (list (+ kc (car L1))(cadr L1))
 n (length tapx)
 k 0
);setq
(setvar "osmode" 0)
 (command "line" p1 p2 ""
  ;;; "text" "j" "m" p11 h 0 "STT" 
   "text" "j" "m" p22 h 0 "Täa ®é X" 
   "text" "j" "m" p33 h 0 "Täa ®é Y"
   "line" p3 p4 "")	

 (while (< k n) 
(setq xx (nth k tapx)
  yy (nth k tapy)
;;; tstt(nth k stt)
             )
(command ;;;;; "text" "j" "m" PTD h 0 tstt 
	 "text" "j" "m" PTX h 0 xx 
	 "text" "j" "m" PTY h 0 yy 
	 "line" PT PTC "")	
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
	 PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
 PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
 PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
 PTY (list (+ kc (car PTX)) (cadr PTX))
  k (+ 1 k));setq
 );while
 (if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
	  PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
  L11 (list (+ di (car PT))(cadr PT))
  L22 (list (+ kc (car L11))(cadr L11))
  );setq
);if
(command "line" p3 PT ""
  "line" p4 PTC ""
  "line" L1 L11 ""
  "line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
 (command "Undo" "End")
 (princ)
);DONG toado

 

 

hì hì bác quá khen. em chẳng qua meo mù vớ phải cá chiên thui. cái lsp của bác em dùng thử thấy y như của em pác ạ. cái vòng tròn đó nó ko chịu biến mất thì làm thế nào hở bác. thank bác trước nhìu nhé.

[hakhoailang 2]

Hề hề hề,

Ây da, nếu đúng như cái elist bạn pót này thì chả phải thay thiếc gì sốt. Bạn gửi bản vẽ lên đây mình coi xem nào chứ vô cái lý, bản vẽ bạn gửi mình nó chạy phăm phăm cơ mà.

file em nó đây bác

bác xem hộ em cái

http://www.mediafire.com/?x4b13z5zzvdykwt

thank bác

[phamthanhbinh 3147]

hì hì bác quá khen. em chẳng qua meo mù vớ phải cá chiên thui. cái lsp của bác em dùng thử thấy y như của em pác ạ. cái vòng tròn đó nó ko chịu biến mất thì làm thế nào hở bác. thank bác trước nhìu nhé.

Hề hề hề,

Ây da, nó y chang là đúng rồi, tại vì cái lisp mình sửa do láu táu nên bị lỗi, khi bạn load nó sẽ thấy báo lỗi là ; error: malformed list on input

Mà khổ nỗi là mình không sửa lệnh nên khi bạn nhập lệnh td1 thì CAD vẫn chạy theo cái lisp cũ của bạn. Vậy chả u như kỹ làm sao được.

Bây chừ bạn làm tiếp như ri chắc là Ok liền.

1/- Tìm tới dòng code:

;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

2/- Đưa con trỏ về vị trí trước dấu ngoặc đóng cuối cùng rồi enter một phát để thành:

;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N

)

3/- Save lại và load nó lên chạy thử coi.

 

Sở dĩ vậy là do cái ngoặc ấy nó đóng hàm command, chứ không phải đóng "text". Mình vẫn để nó trên dòng đó mà thêm ;;; vào đầu nên nó bị vô hiệu hóa và làm cho thằng command khôing được đóng lại. Vậy nên lisp bị lỗi.

Nay bạn enter một phát là nó nhẩy xuống dòng khác và không bị vô hiệu hóa nữa, hề hề hề vậy là OK.

Đảm bảo sau khi bạn làm vậy sẽ không còn cái vòng tròn nào nữa do toàn bộ lisp chỉ có mỗi một dòng code để tạo vòng tròn thì mình đã vô hiệu hóa rồi còn đâu.

Không tin hãy test thử sẽ biết....

Hề hề hề...

[nguyentienthanhddksct 6]

Hề hề hề,

Ây da, nó y chang là đúng rồi, tại vì cái lisp mình sửa do láu táu nên bị lỗi, khi bạn load nó sẽ thấy báo lỗi là ; error: malformed list on input

Mà khổ nỗi là mình không sửa lệnh nên khi bạn nhập lệnh td1 thì CAD vẫn chạy theo cái lisp cũ của bạn. Vậy chả u như kỹ làm sao được.

Bây chừ bạn làm tiếp như ri chắc là Ok liền.

1/- Tìm tới dòng code:

;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

2/- Đưa con trỏ về vị trí trước dấu ngoặc đóng cuối cùng rồi enter một phát để thành:

;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N

)

3/- Save lại và load nó lên chạy thử coi.

 

Sở dĩ vậy là do cái ngoặc ấy nó đóng hàm command, chứ không phải đóng "text". Mình vẫn để nó trên dòng đó mà thêm ;;; vào đầu nên nó bị vô hiệu hóa và làm cho thằng command khôing được đóng lại. Vậy nên lisp bị lỗi.

Nay bạn enter một phát là nó nhẩy xuống dòng khác và không bị vô hiệu hóa nữa, hề hề hề vậy là OK.

Đảm bảo sau khi bạn làm vậy sẽ không còn cái vòng tròn nào nữa do toàn bộ lisp chỉ có mỗi một dòng code để tạo vòng tròn thì mình đã vô hiệu hóa rồi còn đâu.

Không tin hãy test thử sẽ biết....

Hề hề hề...

 

 

hì hì bác quả là hay. rất biết cách chỉ bảo. em đã sửa ok rùi. cám ơn bác rất rất nhìu. em rất muốn học về lsp nhưng do não em nó phẳng quá hay sao ý. em đọc hướng dẫn cách viết lsp mà chẳng hỉu cái mô tê gì cả, bác cho em hỏi các hàm trong lsp là do cad định sẵn hay là mình thêm vô :excl: