Chuyển đến nội dung
Diễn đàn CADViet
Nguyen Hoanh

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

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

Dạ! Bác nói rành khó nghe đó. hix:((. Nhưng mà thích phong cách đó của bác. Hề hề (học điệu cười của Bác^^)! Em có biết chi về viết LISP mô bác mồ. Các bác viết Lisp em biết dùng các Lisp đó là đạ sướng trong con ngài rồi.hihi ^^. Tại vì em thấy mấy anh chị đi làm cũng copy chỉnh sửa kích thước...... mà kiểu làm arứa thì em cũng làm được nói mần chi? Nên em mới có cấy ý tưởng a rứa nà.hihi. "Cấy chi cũng phải cụ thể".hihi Mới học thêm được cấy ni từ bác đó.keke.

P/s: Bác nói từ "ra răng" nên em nghĩ Bác là dân Miền Trung. Chắc những dòng em viết trên bác đọc đc. hề hề^^. Cảm ơn bác nha! :undecided:

Hề hề hề,

Khó nghe là phải quá rồi còn gì, mình post văn bản chớ có audio di ố gì đâu mà nghe cho được....... Ngóng thì còn khả dĩ , phải không hè????

Ý tưởng thì chả có gì sai cả, thậm chí còn tuyệt vời nữa. Tuy nhiên là dân trong nghề của bạn thì bạn phải biết mình có cái chi và cần thêm cái chi chớ. Tụi mìềng dân me cha ni co , ngoại ngạch có biết cái cửa sổ bạn cần nó tròn méo ra răng mà bảo viết với lách. Viết xong nó cho ra cái cửa mà chả ai dám thuê bạn làm thì có mà đem làm cửa ..... mả ư????

Vậy nên chí ít bạn cũng phải cho một cái cửa mà bạn khoái nhất với đầy đủ các thông số ban đầu bạn có và cái cửa cuối cùng mà bạn muốn, có thế thì mới có thể lọ mọ được chớ. Ít ra thì nó cũng còn ra được cái cửa theo ý bạn chớ chưa nói tới ý của mấy ông hàng xóm bạn hỉ.

Thế rồi cũng có thể bạn dựa vào đó mà modify thoải mái chớ, với điều kiện bạn cũng có tí đỉnh khoái vọc lisp bạn à.

Chúc bạn vui và đừng bận tâm tới cái hề hề hề của mình.

  • Vote tăng 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
Chào Bachngoctung,

Quên ư???

Bạn có theo dõi vấn đề bạn đặt ra hay không vậy??? Bản thân mình đã có bài phản hồi , nhưng có thấy bạn ứ hự gì đâu mà bảo quên với nhớ.

Bạn muốn mọi người giúp bạn thì phải cung cấp đầy đủ thông tin về vấn đề bạn đưa ra, đồng thời phải theo dõi và trả lời các câu hỏi mà mọi người đặt ra quanh vấn đề của bạn chứ.

Bạn muốn bắt mọi người phải hiểu vấn đề y như bạn hiểu sao???? Khó đấy, không phải ai cũng giỏi về cái chuyên môn của bạn như bạn đâu.

Hơn nữa với cùng một vấn đề sẽ có thể có nhiều giải pháp để giải quyết chứ không phải chỉ có một giải pháp duy nhất. Do vậy mỗi thành viên sẽ có cách suy nghĩ khác nhau để giải quyết vấn đề của bạn. Mình cũng như những người khác vậy thôi, chả ai muốn làm một việc vô ích cả, do vậy mới có những câu hỏi ngược trở lại để hiểu rõ hơn cũng như đề xuất các giải pháp có thể giúp bạn. Nếu bạn không trả lời thì làm sao để xác tín rằng cái việc mình sẽ làm là phù hợp với yêu cầu của bạn. Và như vậy thì làm làm chi cho mất công nhể???

Diễn đàn là một nơi công cộng, bạn nên tôn trọng mọi người trước khi yêu cầu mọi người phải tôn trọng bạn bạn ạ. Đừng chỉ biết đòi hỏi ở người khác mà không quan tâm xem người khác nghĩ gì...

Vài lời góp ý mong bạn chớ giận......

-HEHE ko có gì, người muốn giúp đỡ mà ko thấy ngưới đưọc giúp đỡ ý kiến gì thì bực là đúng. Mấy hôm công ty mình mất mạng nên ko vô đây theo dõi dc, giờ thì ok rồi, mai mình lên công ty(mới biết thông báo là mai có heheehe) sẽ đọc kỹ những gì các bạn đã giúp mình rồi đưa ra nhưng yêu cầu mà mình muốn rõ ràng hơn. Chân thành cám ơn và chân thành xin lỗi :undecided:

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
Hề hề hề,

Đã phát hiện ra, đây là cái điểm chèn của block chứ không phải điểm thuộc block. Do vậy nếu chỉ xóa block thì nó vẫn nằm chình ình ra ăn vạ ở đó chứ chả chịu biến đi. Mình đã sửa lại cái lisp trên để xóa béng thằng này. Bạn thử xem nhé.

(defun c:chpt (/ ss n i bln ebl en els txt ptxt htxt gtxt stxt ltxt ssc p1 p2 ssp)
(vl-load-com)
(command "undo" "be")
(setq ss (ssget (list (cons 0 "INSERT")))
       n (sslength ss)
       i 0)
(while (< i n)
       (setq bln (ssname ss i)
               ebl (entget bln)
               ssc (ssadd bln)
               p1 (car (acet-geom-ss-extents-fast ssc))
               p2 (cadr (acet-geom-ss-extents-fast ssc))
               ssp (ssget "w" p1 p2)
       )
       (if (and ( = (cdr (assoc 2 ebl)) "WAYPOINT") (= (cdr (assoc 66 ebl)) 1))
           (progn
                  (setq en (entnext bln)
                          els (entget en))
                  (while (/= (cdr (assoc 0 els)) "SEQEND")
                           ( if (= (cdr (assoc 2 els)) "Visible")
                                (progn 
                                        (setq txt (cdr (assoc 1 els))
                                                ptxt (cdr (assoc 10 els))
                                                htxt (cdr (assoc 40 els))
                                                gtxt (cdr (assoc 50 els))
                                                stxt (cdr (assoc 7 els))
                                                ltxt (cdr (assoc 8 els))
                                         )
                                         (entmake (list (cons 0 "TEXT")
                                                              (cons 1 txt)
                                                              (cons 40 htxt)
                                                              (cons 10 ptxt)
                                                              (cons 50 gtxt)
                                                              (cons 7 stxt)
                                                              (cons 8 ltxt)
                                                              (cons 62 1)
                                                        )
                                           )
                                           (entmake (list (cons 0 "POINT")
                                                             (cons 10 ptxt)
                                                             ;;;;;;(cons 40 0.001)
                                                             (cons 8 ltxt)
                                                             (cons 62 2)
                                                         )
                                           )
                                   )
                               )
                               (setq en (entnext en)
                                       els (entget en))
                     )
                     (command "erase" ssp "") 
              )
          )
          (setq ssc nil) 
          (setq i (1+ i))
)
(command "undo" "e")
(princ)
)

 

Chúc bạn vui, nếu bạn muốn chỉnh sửa lại màu và lớp của các đối tượng mới thì có thể vào sửa ngay trong các hàm entmake bạn nhé. Nó cũng đơn giản thôi.

Vài góp ý code của bạn

1. Dùng (ssget "w" p1 p2) rất nguy hiểm vì

- Có thể sẽ chọn thêm các đối tượng khác dẫn đến xóa mất chúng.

- Nếu p1 p2 không nằm trên màn hình, code trên không select được gì.

Bạn có thể thử bằng cách zoom lớn 1 vùng, đánh lệnh, chọn All rồi kiểm tra kết quả

Cách sửa:

Trong trường hợp tổng quát, dùng hàm entdel

Trong bài này đưa vào điều kiện filter:

(ssget (list (cons 0 "INSERT")(cons 2 "WAYPOINT")(cons 66 1)))

sau đó xóa toàn bộ ss

2. Code thừa:

Bạn không dùng trực tiếp txt mà dùng (cons 1 txt) vì vậy

chỉ cần (assoc 1 els) thay cho

(setq txt (cdr (assoc 1 els))) và (cons 1 txt)

  • Vote tăng 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
Hề hề hề,

Tức khí rùi hử????

Cái cách đặt vấn đề như bạn thì sẽ dốt hoài thôi..... Bạn nói cứ như tất cả mọi người đều giỏi nova với vẽ cống như bạn vậy. Nhầm to rồi, bạn nên cho cái ví dụ cụ thể về cái bạn cần thì mới nói chuyện tiếp được. Còn mấy cái đã có nếu bạn không bí mật thì hãy cho mọi người xem mặt ngang mũi dôc nó ra sao mới bắt chước được chớ... Còn cái kiểu úp úp mở mở, đánh đố bà con vậy, chả ai khoái cả đâu. Có thì xài chả có thì nhịn chớ sao. Trước giờ vẫn chả biết có nó thì nay không có cũng vẫn cứ được bạn à.....

Chuyện khích bác lẫn nhau ở đây cũng chả phải là nên làm, autolisp nó có làm được hay không là việc của nó, còn mình có cần làm hay không là việc của mình. Khi đã cần thì chả có ô tô, chạy bộ cũng cứ phải chạy chớ khích bác nhau thì được cái chi????

Thế đấy, bạn à.

Bây giờ, nếu bạn thấy chán thì thôi, đừng thèm chơi với mình nữa, song nếu thấy phải thì hãy chịu khó nghiền ngẫm kỹ cái ý tưởng của bạn và post vấn đề lên cho nó rõ ràng, cụ thể. Đầu vào bạn có những gì, đầu ra bạn muốn ra sao, còn cái khúc xử lý thì để tùy mọi người cảm hứng. Như vậy may ra mới có người trả lời bạn được.

Hề hề hề,..

Chúc bạn vui.

 

- Chào anh phạm thanh bình!

Rất cảm ơn những góp ý của anh. Em thì hoc hoài vẫn dốt nhưng dốt vẫn học hoài anh à, nên em không chán đâu anh. Còn em nói Autolisp có làm được không là hỏi thật đấy anh. Có thể một số chức năng lisp không làm được đúng không, nên mới hỏi các anh pro đó chứ em mới tập tành làm sao biết được. Còn lần post sau mà anh hiểu lầm là "khích bác" là em sợ nhiều bài yêu cầu của thành viên khác quá các anh không thấy những dòng của em nên em "nhắc" các anh giúp dùm í mà. Các anh thông cảm em sẽ rút kinh nghiệm lần sau. Em xin diễn đạt lại câu hỏi của em như sau:

Đây là hộp thoại nhập số liệu của chương trình cống

Sau khi nhập số liệu. Bấm lưu

1_10.jpg

Chọn đường dẫn để lưu dữ liệu vào file có định dạng .tcg (Định dạng riêng của chương trình TK cống)

2_7.jpg

Trương hợp tôi muốn lấy lại các số liệu đã nhập để sửa chửa đính chính vài số liệu nào đó. Tôi bấm Open

3_2.jpg

Chọn đường dẫn file lưu trước đây

4.jpg

Dữ liệu đã phục hồi, Bây giờ thì tha hồ chỉnh sửa và nhìn ngắm.

5.jpg

Em xin hỏi là làm thế nào để làm được như vậy. Phần hộp thoại tạo ra các bottun Mở / Lưu thì có thể em làm được nhưng tạo ra 1 file lưu (1 định dạng của chương trình riêng của mình) thì em không biết.

Cảm ơn diễn đàn đã đọc hết ý của em. Em diễn đạt kém quá.

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
- Chào anh phạm thanh bình!

Rất cảm ơn những góp ý của anh. Em thì hoc hoài vẫn dốt nhưng dốt vẫn học hoài anh à, nên em không chán đâu anh. Còn em nói Autolisp có làm được không là hỏi thật đấy anh. Có thể một số chức năng lisp không làm được đúng không, nên mới hỏi các anh pro đó chứ em mới tập tành làm sao biết được. Còn lần post sau mà anh hiểu lầm là "khích bác" là em sợ nhiều bài yêu cầu của thành viên khác quá các anh không thấy những dòng của em nên em "nhắc" các anh giúp dùm í mà. Các anh thông cảm em sẽ rút kinh nghiệm lần sau. Em xin diễn đạt lại câu hỏi của em như sau:

Đây là hộp thoại nhập số liệu của chương trình cống

 

Em xin hỏi là làm thế nào để làm được như vậy. Phần hộp thoại tạo ra các bottun Mở / Lưu thì có thể em làm được nhưng tạo ra 1 file lưu (1 định dạng của chương trình riêng của mình) thì em không biết.

Cảm ơn diễn đàn đã đọc hết ý của em. Em diễn đạt kém quá.

Hề hề hề,

Chào bạn hochoaivandot,

Xin lỗi nếu đã làm bạn không vui. Tuy nhiên việc bạn tiếp tục post bài đã chứng tỏ rằng bạn không giận mình. Đọc yêu cầu của bạn mình thấy lisp hoàn toàn có khả năng giải quyết vấn đề của bạn. Việc tạo hộp thoại với các chức năng tương tự như cái hộp thoại bạn nêu ra tuy có hơi phức tạp nhưng mình nghĩ lisp có thể làm tốt. Có điều thật lòng mà nói thì mình không thể làm được giúp bạn vì chả hiểu gì về chuyên môn này của bạn cả. Từ cái số liệu này làm gì để cho ra cái cống thì mình chịu chết.

Với lisp mình không rõ nó có lưu ra được cái file *.tcg như của bạn hay không nhưng chắc chắn nó lưu được ra các file dạng *.txt, *.cvs thậm chí cả *.xls nữa bạn ạ. Và như vậy thì cũng chả khác cái file *. tcg của bạn bao nhiêu. Vấn đề chỉ là cái phần mềm thiết kế cống của bạn có chấp nhận các file số liệu dạng *. txt hay *.cvs hay *.xls không mà thôi.

Trường hợp nó không chấp nhận thì bạn phải tìm hiểu xem có cách gì để convert các file này về file dạng *. tcg của bạn.

Để hiểu rõ hơn về cách lisp lưu số liệu vào các file *. txt, *.cvs, *.xls bạn có thể tham khảo trên diễn đàn và một số lisp sau bạn nhé.

http://www.cadviet.com/upfiles/3/cvstocad.lsp

http://www.cadviet.com/upfiles/3/xls2cad.lsp

http://www.cadviet.com/upfiles/3/ex2cad.lsp

http://www.cadviet.com/upfiles/3/exptxt.lsp

http://www.cadviet.com/upfiles/3/get_datapoint.lsp

http://www.cadviet.com/upfiles/3/get_xl_sheet.lsp

http://www.cadviet.com/upfiles/3/pt2exl.lsp

http://www.cadviet.com/upfiles/3/ptexport.lsp

Việc gán các lisp này vào chức năng của các button trong hộp thoại chắc bạn cũng đã rành nên mình không bổ sung thêm gì.

Bạn hãy thử sử dụng xem nhé. Mình tin là bạn sẽ thành công.

  • Vote tăng 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
Hề hề hề,

Bạn Phamngoctukts ơi,

Ngó vậy mà hổng phải vậy đâu, đó không phải là tọa độ của điểm mà là tọa độ của vec tơ pháp tuyến của đường cong tại chính cái điểm đang xét trên đường cong bác à. Còn mối liên hệ giữa cái véc tơ pháp tuyến này với bán kính của đường cong tại điểm đó chắc bác phải mò thêm chút xíu nữa bác à. Tỷ như cái đoạn lisp bác viết là nó xác định cái véc tơ pháp tuyến tại điểm giữa của đường cong đó .

Rất mong bác thành công....

Hề hề như vầy đúng rồi chớ hở bác Bình

(defun c:tam()
 (setq dt (entsel))
 (setq  ename (car dt))
 (setq  obj (vlax-ename->vla-object ename))
 (setq  pt (vlax-curve-getendparam ename))
 (setq  pt1 (vlax-curve-getpointatparam obj pt))
 (setq deriv2 (vlax-curve-getSecondDeriv obj pt))
 (setq tam (mapcar '+ pt1 deriv2))
)

với pline có đoạn cuối là arc

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
Vài góp ý code của bạn

1. Dùng (ssget "w" p1 p2) rất nguy hiểm vì

- Có thể sẽ chọn thêm các đối tượng khác dẫn đến xóa mất chúng.

- Nếu p1 p2 không nằm trên màn hình, code trên không select được gì.

Bạn có thể thử bằng cách zoom lớn 1 vùng, đánh lệnh, chọn All rồi kiểm tra kết quả

Cách sửa:

Trong trường hợp tổng quát, dùng hàm entdel

Trong bài này đưa vào điều kiện filter:

(ssget (list (cons 0 "INSERT")(cons 2 "WAYPOINT")(cons 66 1)))

sau đó xóa toàn bộ ss

2. Code thừa:

Bạn không dùng trực tiếp txt mà dùng (cons 1 txt) vì vậy

chỉ cần (assoc 1 els) thay cho

(setq txt (cdr (assoc 1 els))) và (cons 1 txt)

Chào bác ndtnv,

Rất cám ơn bác đã chỉ ra những nhược điểm của mình. Quả thật điều này mình cũng đã phát hiện khi chạy thử lísp nhưng chưa biết cách khắc phục bác ạ. Với cách khắc phục như bác chỉ thì cái point điểm đặt của block vẫn chưa được xóa do nó không thuộc vào block bác ạ. Theo mình nghĩ có nhẽ phải đưa thêm cái point này vào trong tập chọn ss nhưng đưa kiểu gì cho hợp lý thì lại chưa nghĩ ra. Mình sẽ cố gắng để hoàn thiện nó lại theo ý bác.

Chào bác và chúc bác luôn vui, khỏe.

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
Hề hề như vầy đúng rồi chớ hở bác Bình

(defun c:tam()
 (setq dt (entsel))
 (setq  ename (car dt))
 (setq  obj (vlax-ename->vla-object ename))
 (setq  pt (vlax-curve-getendparam ename))
 (setq  pt1 (vlax-curve-getpointatparam obj pt))
 (setq deriv2 (vlax-curve-getSecondDeriv obj pt))
 (setq tam (mapcar '+ pt1 deriv2))
)

với pline có đoạn cuối là arc

Hề hề hề,

Chào bác phamngoctukts,

Bác hỏi khó quá, biết bác cần lấy cái chi mà bảo đúng với sai.

Đoạn lisp trên của bác nếu là để lấy tọa độ tâm của cái arc ở cuối đường pline thì có nhẽ đúng, nhưng mà để lấy bán kính cong của cung này thì hình như trật chìa bác ạ.

Vậy bác cần cái chi nhể????

Hề hề hề,.....

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
Bác nào cho em hỏi:

Lây tâm của đoạn pline cong thì làm thế nào.

phamngoctukts tham khảo LISP cho thông tin về PLINE.

(lisp này chưa phải cách nhanh nhất) <_<

Giá trị trả về là 1 danh sách (list) các dotpair (Ten . value)

- nếu segment là ARC thì thông số kèm theo là tâm của ARC đó

- nếu segment là LINE thì thông số kèm theo là góc nghiêng của LINE đó.

VD :

- (("Line" . 0.476269) ("Arc" 95760.2 40265.4 0.0) ("Line" . 6.13458) ("Arc" 101546.0 40029.4 0.0))

Code

(defun c:PLInfo(/ cEnt lst param oo)
 (if (and (setq cEnt (car (entsel "\nSelect Curve: ")) )
   (wcmatch (cdr (assoc 0 (entget cEnt))) "*POLYLINE") )
   (progn
     (setq param 0)
     (while (< param (vlax-curve-getEndParam cEnt))
(if (setq oo (get_center cEnt param))
  (setq lst (append (list (cons "Arc" oo)) lst))
  (setq lst (append (list (cons "Line" (angle (vlax-curve-getPointAtParam cEnt param)
					      (vlax-curve-getPointAtParam cEnt (1+ param))))) lst)) )
(setq param (1+ param))	)
     (reverse lst) )
   (alert "No POLYLINE Selected !")) )

(defun get_center (ent param / ang1 ang2 ang3 oo pt1 pt2)
 (setq ang1 (angle '(0 0 0) (vlax-curve-getFirstDeriv Ent (+ 0.1 param)))
ang2 (angle '(0 0 0) (vlax-curve-getFirstDeriv Ent (+ 0.9 param))))
 (if (/= ang1 ang2)
   (setq oo T)
   (progn
     (setq ang3 (angle '(0 0 0) (vlax-curve-getFirstDeriv Ent (+ 0.5 param))))
     (if (/= ang1 ang3)(setq oo T))  ) )
 (if oo
   (progn
     (setq pt1 (vlax-curve-getPointAtParam ent (+ 0.1 param))
    pt2 (vlax-curve-getPointAtParam ent (+ 0.9 param)))
     (inters pt1 (polar pt1 (- ang1 (/ pi 2)) 50) pt2 (polar pt2 (- ang2 (/ pi 2)) 50) nil)  )  )  )

  • Vote tăng 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
phamngoctukts tham khảo LISP cho thông tin về PLINE.

(lisp này chưa phải cách nhanh nhất) <_<

Giá trị trả về là 1 danh sách (list) các dotpair (Ten . value)

- nếu segment là ARC thì thông số kèm theo là tâm của ARC đó

- nếu segment là LINE thì thông số kèm theo là góc nghiêng của LINE đó.

VD :

- (("Line" . 0.476269) ("Arc" 95760.2 40265.4 0.0) ("Line" . 6.13458) ("Arc" 101546.0 40029.4 0.0))

Cám ơn bác gia_bach rất nhiều.

Bây giờ em mới ngâm cứu đến code ActiveX (nhìn thấy bọn này là ớn). Tiện thể bác cho em hỏi cái? Nếu không dùng code ActiveX thì có lấy được tâm của Pline cong không

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
Vài góp ý code của bạn

1. Dùng (ssget "w" p1 p2) rất nguy hiểm vì

- Có thể sẽ chọn thêm các đối tượng khác dẫn đến xóa mất chúng.

- Nếu p1 p2 không nằm trên màn hình, code trên không select được gì.

Bạn có thể thử bằng cách zoom lớn 1 vùng, đánh lệnh, chọn All rồi kiểm tra kết quả

Cách sửa:

Trong trường hợp tổng quát, dùng hàm entdel

Trong bài này đưa vào điều kiện filter:

(ssget (list (cons 0 "INSERT")(cons 2 "WAYPOINT")(cons 66 1)))

sau đó xóa toàn bộ ss

2. Code thừa:

Bạn không dùng trực tiếp txt mà dùng (cons 1 txt) vì vậy

chỉ cần (assoc 1 els) thay cho

(setq txt (cdr (assoc 1 els))) và (cons 1 txt)

Chào bác ndtnv và bạn quynhnn

Đây là cái lisp mình đã sửa lại theo góp ý của bác ndtnv để khắc phục cái lỗi do lisp trước sử dụng hàm (setq ssp (entget "W" p1 p2)). Sử dụng như vầy với các điểm gần nhau có thể bị mất đi mà người dùng không biết hoặc giả bị mất lây các đối tượng khác có trong vùng chọn. Rất mong bạn quynhnn thông cảm vì khả năng của mình còn phải học hỏi thêm các bác khác nữa mới có thể hoàn thiện hơn được.

(defun c:chpt (/ ss n i bln ebl en els ptxt htxt gtxt stxt ltxt p1 ssp)
(vl-load-com)
(command "undo" "be")
(setq ss (ssget (list (cons 0 "INSERT") (cons 2 "WAYPOINT") (cons 66 1)))
       n (sslength ss)
       i 0)
(while (        (setq bln (ssname ss i)
               ebl (entget bln)
               p1 (cdr (assoc 10 ebl))                
               ssp (ssget "x" (list (cons 0 "POINT") (cons 10 p1)))
       )
       (setq en (entnext bln)
               els (entget en))
       (while (/= (cdr (assoc 0 els)) "SEQEND")
                ( if (= (cdr (assoc 2 els)) "Visible")
                     (progn 
                              (setq ptxt (cdr (assoc 10 els))
                                      htxt (cdr (assoc 40 els))
                                      gtxt (cdr (assoc 50 els))
                                      stxt (cdr (assoc 7 els))
                                      ltxt (cdr (assoc 8 els))
                              )
                              (entmake (list (cons 0 "TEXT")
                                                   (assoc 1 els)
                                                   (cons 40 htxt)
                                                   (cons 10 ptxt)
                                                   (cons 50 gtxt)
                                                   (cons 7 stxt)
                                                   (cons 8 ltxt)
                                                   (cons 62 1)
                                             )
                                           )
                              (entmake (list (cons 0 "POINT")
                                                   (cons 10 ptxt)
                                                   (cons 8 ltxt)
                                                   (cons 62 2)
                                              )
                              )
                       )
                    )
                    (setq en (entnext en)
                             els (entget en))
         )
         (if (/= ssp nil)
             (command "erase" ssp bln "") 
             (command "erase" bln "")
         )
         (setq i (1+ i))
)
(command "undo" "e")
(princ)
)

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
Hề hề hề,

Chào bác phamngoctukts,

Bác hỏi khó quá, biết bác cần lấy cái chi mà bảo đúng với sai.

Đoạn lisp trên của bác nếu là để lấy tọa độ tâm của cái arc ở cuối đường pline thì có nhẽ đúng, nhưng mà để lấy bán kính cong của cung này thì hình như trật chìa bác ạ.

Vậy bác cần cái chi nhể????

Hề hề hề,.....

Hề hề Bác lại nói .... rồi.

biết toạ độ 2 điểm rồi thì lấy khoảng cách có khó gì....

Bác có tài liệu về code ActiveX không cho em xin với!! Em đang ngâm cứu phần này.

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
Hề hề Bác lại nói .... rồi.

biết toạ độ 2 điểm rồi thì lấy khoảng cách có khó gì....

Bác có tài liệu về code ActiveX không cho em xin với!! Em đang ngâm cứu phần này.

Chào bác Phamngoctults,

Thú thực là cái món ActiveX này mình mít đặc, qua diễn đàn này mới biết có nó và đang đi mót của các bác khác về xài vụng thôi. Thực tế mình muốn tìm tài liệu về nó để vọc cho nhanh mà chả biết kiếm đâu ra. Cứ lọ mọ nhặt nhạnh của các bác khác nên nó vụn vặt và chả có cơ sở lý luận gì cả, mót được cái gì thì cố thử vọc vạch một tí nhưng vớ phải mấy cái toàn xơ là xơ, giắt răng lắm bác à..... Cái thằng Help của CAD nó có nói loáng thoáng mà mình đọc cũng chả thông, vậy nên đành là cứ rình nhặt của các bác khác về xài cho nó ..... lành thôi. Hiểu được cái gì dùng cái đó, còn chỗ nào chưa hiểu thì cứ treo nó lên chờ các bác xì ra tới đâu mình lượm tới đó vậy.

Hề hề hề, cái sự dốt nó hại mình vậy đó......

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

mấy bác giúp em cái này với mà em không biết đặt câu hỏi ở đây có đúng không nữa.em co tải mấy lisp trên diễn đàn mình về mà không biết dùng(nghĩa là thao tác trên dòng command không biết kiểu sao hết, nhưng em biết tên lisp rùi) sao cả ,mấy bác coi giúp em voi.em cam ơn nhiều.http://www.cadviet.com/upfiles/3/tinhthang.lsp quả thật em mơi tập tành học cad nên còn dút lém :undecided: sẵn đây bác nào có lisp scale theo 2 trục x y không cho em xin vớ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
Hề hề như vầy đúng rồi chớ hở bác Bình

(defun c:tam()
 (setq dt (entsel))
 (setq  ename (car dt))
 (setq  obj (vlax-ename->vla-object ename))
 (setq  pt (vlax-curve-getendparam ename))
 (setq  pt1 (vlax-curve-getpointatparam obj pt))
 (setq deriv2 (vlax-curve-getSecondDeriv obj pt))
 (setq tam (mapcar '+ pt1 deriv2))
)

với pline có đoạn cuối là arc

Hề hề hề,

Đoạn lisp trên của bác nếu là để lấy tọa độ tâm của cái arc ở cuối đường pline thì có nhẽ đúng.......

Hề hề hề,.....

Đúng 50%, sai 50%

Hề hề Bác lại nói .... rồi.

biết toạ độ 2 điểm rồi thì lấy khoảng cách có khó gì....

Do đó, cái việc lấy khoảng cách -> Đúng 50%, sai 50%

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
Nhờ các bác viết giùm lisp vẽ Elliptical Head có thông số như hình đính kèm, vẽ bằng line hoặc pline đều được. Cám ơn nhiều

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

Bác thử cái này nhé :

(defun c:veh(/ ID R1 H L tam maxp maxp_H minX maxX Lmin Lmax
    g1 g2 e1 e2 e3 os)
 (setq os (getvar "osmode"))
 (setvar "osmode" 0)
 (setq ID (getdist "\n Nhap tri so ID :")
R1 (* ID 0.9045) R2 (* ID 0.1728)
H (/ ID 4) L (* ID 0.3272)
 )
 (setq tam (getpoint "\n Chon diem tam cua cung R1 :"))
 (setq maxp (list (car tam) (+ (cadr tam) R1) 0.0)
maxp_H (list (car tam) (- (+ (cadr tam) R1) H) 0.0)
minX (list (- (car tam) (/ ID 2)) (cadr maxp_H) 0.0)
maxX (list (+ (car tam) (/ ID 2)) (cadr maxp_H) 0.0)
Lmin (list (- (car tam) L) (cadr maxp_H) 0.0)
Lmax (list (+ (car tam) L) (cadr maxp_H) 0.0)
 )
 (command "circle" tam R1)(setq e1 (entlast))
 (command "circle" Lmin R2)(setq e2 (entlast))
 (command "circle" Lmax R2)(setq e3 (entlast))
 (setq g1 (car (ACET-GEOM-INTERSECTWITH e1 e2 0)))
 (setq g2 (car (ACET-GEOM-INTERSECTWITH e1 e3 0)))
 (command "arc" "c" tam g2 g1)
 (command "arc" "c" Lmin g1 minX)
 (command "arc" "c" Lmax maxX g2)
 (entdel e1) (entdel e2) (entdel e3)
 (command "line" tam maxp "")
 (command "line" Lmin g1 "")
 (command "line" Lmax g2 "")
 (command "line" minX maxX "")
 (setvar "osmode" os)
(princ)
)

  • Vote tăng 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

Mình sưu tầm được 1 lisp biểu tượng cao độ thấy rất hay.Nhưng khi tạo ra cao độ nó là những đường line bình thường.Nhờ các bác chỉnh sửa làm sao khi tạo ra nó là Block ATT.chân thành cảm ơn trước.

http://www.cadviet.com/upfiles/3/ctrinh.lsp

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
Mình sưu tầm được 1 lisp biểu tượng cao độ thấy rất hay.Nhưng khi tạo ra cao độ nó là những đường line bình thường.Nhờ các bác chỉnh sửa làm sao khi tạo ra nó là Block ATT.chân thành cảm ơn trước.

http://www.cadviet.com/upfiles/3/ctrinh.lsp

 

Bạn tham khảo cái này thử xem: http://www.cadviet.com/forum/index.php?showtopic=21470

Nó tạo ra block ATT như ý bạn.

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

Em xin phép đào lại bài 1 chút,vì những thắc mắc của e bị trôi đi nhanh quá^^

 

Có cách nào khóa 1 đối tượng giống như đóng băng không ạ ? (k phải đóng băng layer chứa đối tượng đó)

Em thấy chức năng này rất cần thiết nhưng hình như chưa có

E nghĩ có cách là copy đối tượng sang 1 layer temp,layer này có tính chất giống layer của đối tượng,nhưng bị khóa.Sau khi unlock thì trả đối tượng về layer cũ và (có thể) xóa layer temp đi.Nhưng lại có vấn đề là nếu có nhiều đối tượng thuộc nhiều layer khác nhau thì phải tạo ra nhiều layer temp,hoặc phải lưu giữ thông tin của nhiều đối tượng trước khi bị khóa.Nhưng kể cả như vậy thì có thể thực hiênện được không ạ ??Em k biết lập trình nên không triển khai được ý đồ,mong các bác giúp đỡ ..

Bac tue nói có thể thực hiện,nên e vẫn mong ý đồ này được các bác giúp đỡ ^^

 

- Thực hiện lệnh bắn line (hoặc pline) vào giao điểm của 2 đường line gần nhất.Ở đầu vào User kích chọn vào đường line cần bắn.

- Thực hiện lệnh bắn line (hoặc pline) vào 1 điểm gấp khúc gần nhất của các đường pline xung quanh.Ở đầu vào User kích chọn vào đường line cần bắn và có lựa chọn pick hay không cần kick vào pline.(Giống lệnh ex,hay trim,có thể chọn hoặc không chọn đường biên ý ạ.vì có thể có nhiều pl xung quanh mũi đường l,pl gốc,người dùng không phải băn khoăn xem đường nào gần nhất).

Mong các bác giúp đỡ e vấn đề 1,còn vấn đề 2 thì với bản thân e chưa cần thiết lắm,e chỉ nghĩ nên mở rộng vấn đề như thế thôi.hì ^^

55010618.gif

68191987.gif

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
Bạn tham khảo cái này thử xem: http://www.cadviet.com/forum/index.php?showtopic=21470

Nó tạo ra block ATT như ý bạn.

Ý mình không phải vậy.Trong đoạn lisp mình gửi lên khi đánh CT thì mặc định nó sẽ vẽ biểu tượng cao trình mình chỉ cần chọn điểm để đặt nó thôi.Nhưng khi lisp tự vẽ biểu tượng cao trình này ra nó không phải là block ATT,nhờ các chỉnh sửa lisp này sao cho khi vẽ ra thì nó là BLock ATT.thanks

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
mấy bác giúp em cái này với mà em không biết đặt câu hỏi ở đây có đúng không nữa.em co tải mấy lisp trên diễn đàn mình về mà không biết dùng(nghĩa là thao tác trên dòng command không biết kiểu sao hết, nhưng em biết tên lisp rùi) sao cả ,mấy bác coi giúp em voi.em cam ơn nhiều.http://www.cadviet.com/upfiles/3/tinhthang.lsp quả thật em mơi tập tành học cad nên còn dút lém :undecided: sẵn đây bác nào có lisp scale theo 2 trục x y không cho em xin với.

lisp scale theo 2 trục x y xem ở đây:

http://www.cadviet.com/forum/index.php?sho...near&start=

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
Ý mình không phải vậy.Trong đoạn lisp mình gửi lên khi đánh CT thì mặc định nó sẽ vẽ biểu tượng cao trình mình chỉ cần chọn điểm để đặt nó thôi.Nhưng khi lisp tự vẽ biểu tượng cao trình này ra nó không phải là block ATT,nhờ các chỉnh sửa lisp này sao cho khi vẽ ra thì nó là BLock ATT.thanks

 

Bạn tham khảo cái này nhé:

;VE CAO TRINH
(DEFUN C:CT (/ CMD NBC OSM PT1 TSIZE STR PRMT)
(if (not (tblsearch "layer" "ghichu"))
(command "layer" "m" "ghichu" "c" "150" """")
)

(if (not (tblobjname "block" "CTrinh"))
 	(taobl)
)  	
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ NBC (GETVAR "CLAYER"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)(SETVAR "DIMZIN" 0)
(setvar "ATTMODE" 1)(setvar "attdia" 0)(setvar "attreq" 1)
(SETQ 	PT1 (GETPOINT "\nDiem cao trinh:"))
(if (not TSIZE1)
 	(SETQ	TSIZE1 (GETVAR "TEXTSIZE"))
 )	
(SETQ	STR (RTOS TSIZE1 2)
PRMT (STRCAT "\nText height <" STR ">:")
TSIZE (GETDIST PRMT)
)
(if (not TSIZE)
 (SETQ TSIZE TSIZE1)
 (SETQ TSIZE1 TSIZE)
)  
(PRINC "\n")
(command "-insert" "CTrinh" PT1 TSIZE "" "0")
(SETVAR "CMDECHO" CMD)
(SETVAR "CLAYER" NBC)
(SETVAR "OSMODE" OSM)
(PRINC)
)
;---------------------
(defun taobl()
(entmake '((0 . "BLOCK")(2 . "CTrinh")(70 . 2)(10 0.0 0.0 0.0)))  
(entmake 
   	'((0 . "LINE")(62 . 150)(8 . "ghichu")
  (10 -1.0 0.0 0.0)(11 1.0 0.0 0.0)))
(entmake 
   	'((0 . "LINE")(62 . 7)(8 . "ghichu")
  (10 0.0 0.0 0.0)(11 1.0 0.5 0.0)))
(entmake 
   	'((0 . "LINE")(62 . 7)(8 . "ghichu")
  (10 1.0 0.5 0.0)(11 -1.0 0.5 0.0)))
(entmake 
   	'((0 . "LINE")(62 . 150)(8 . "ghichu")
  (10 0.0 0.0 0.0)(11 0.0 3.0 0.0)))
(entmake 
   	'((0 . "LINE")(62 . 150)(8 . "ghichu")
  (10 -1.0 1.0 0.0)(11 4.5 1.0 0.0)))
(entmake 
   	'((0 . "SOLID")(62 . 7)(8 . "ghichu")
  (10 0.0 0.0 0.0)(11 0.0 0.5 0.0)
  (12 -1.0 0.5 0.0)(13 0.0 0.5 0.0)
 	  (39 . 0.0)))
(entmake 
   	'((0 . "ATTDEF")(8 . "ghichu")
  (10 0.25 1.50 0.0)
  (1 . "0.00")
  (2 . "CT_ID")
   	  (3 . "Gia_tri_cao_trinh:")
  (40 . 1.0)(41 . 1.0)
  (50 . 0.0)(70 . 0)
  (71 . 0)(72 . 0)(62 . 84)
  (73 . 0)))
(entmake '((0 . "ENDBLK")))	  
)
;---------------------
(defun c:bn()
(command "osnap"  "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par"  )
)

 

Có gì Post lại nhé!!!

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
Bác thử cái này nhé :

(defun c:veh(/ ID R1 H L tam maxp maxp_H minX maxX Lmin Lmax
    g1 g2 e1 e2 e3 os)
 (setq os (getvar "osmode"))
 (setvar "osmode" 0)
 (setq ID (getdist "\n Nhap tri so ID :")
R1 (* ID 0.9045) R2 (* ID 0.1728)
H (/ ID 4) L (* ID 0.3272)
 )
 (setq tam (getpoint "\n Chon diem tam cua cung R1 :"))
 (setq maxp (list (car tam) (+ (cadr tam) R1) 0.0)
maxp_H (list (car tam) (- (+ (cadr tam) R1) H) 0.0)
minX (list (- (car tam) (/ ID 2)) (cadr maxp_H) 0.0)
maxX (list (+ (car tam) (/ ID 2)) (cadr maxp_H) 0.0)
Lmin (list (- (car tam) L) (cadr maxp_H) 0.0)
Lmax (list (+ (car tam) L) (cadr maxp_H) 0.0)
 )
 (command "circle" tam R1)(setq e1 (entlast))
 (command "circle" Lmin R2)(setq e2 (entlast))
 (command "circle" Lmax R2)(setq e3 (entlast))
 (setq g1 (car (ACET-GEOM-INTERSECTWITH e1 e2 0)))
 (setq g2 (car (ACET-GEOM-INTERSECTWITH e1 e3 0)))
 (command "arc" "c" tam g2 g1)
 (command "arc" "c" Lmin g1 minX)
 (command "arc" "c" Lmax maxX g2)
 (entdel e1) (entdel e2) (entdel e3)
 (command "line" tam maxp "")
 (command "line" Lmin g1 "")
 (command "line" Lmax g2 "")
 (command "line" minX maxX "")
 (setvar "osmode" os)
(princ)
)

Cám ơn Bác Tuệ nhiều, bác bổ sung thêm đoạn đứng dài 50 hai bên như trong hình giùm, ở bất kỳ ID nào đều có đoạn này

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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×