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

tnmtpc

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    365

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    7

Bài đăng được đăng bởi tnmtpc

  2. Đã đăng · Trả lời báo cáo

    Mình đã tạo file acad.lsp, trong đó đã thiết lập các lệnh để load file, ví dụ

    (load "C:\\LISP\\CTL_WIN.fas")

    (load "C:\\LISP\\DTM.vlx")

    (load "C:\\LISP\\ASCII_IN.lsp")

    .............................................

    trong Suport file search path của autocad đã khai báo đường dẫn tới nơi chứa file acad.lsp nhưng autocad vẫn không nhận lệnh của các file CTL_WIN.fas, DTM.vlx, ASCII_IN.lsp ..... Các file đều lưu đúng vị trí đường dẫn trong lệnh "load" của acad.lsp

    Các bạn chỉ cho mình cách khắc phục ( dùng cad 2004)

  5. Đã đăng · Trả lời báo cáo

    *Bạn muốn line thuộc layer như nào:

    -1 layer nhất định (cụ thể tên, màu).

    -Theo layer của text.

    *Khoảng cách line đến text như nào:

    -Khoảng cố định (cụ thể).

    -Tỉ lệ với chiều cao text (cụ thể).

    Lưu ý lisp sẽ không kiểm soát được text đã gạch chân chưa nên nếu đã có rồi thì nó gạch thêm 1 đường nửa.

    Line nằm trên layer hiện hành (do người sử dụng thiết lập trước)

    khoảng hở line và text tỷ lệ theo chiều cao text do người sử dụng nhập trong command line

    Chiều dài line bằng chiều dài text

    Nếu được , lisp có hai tùy chọn: line dưới text và trên text

  7. Đã đăng · Trả lời báo cáo

    Mình có một lisp tạo đường gạch dưới text, khi pick vào text thì text sẽ có đường gạch dưới text, nhưng phải pick từng text một, trong bản vẽ của mình có tới hàng ngàn text, không lẽ ngồi pick hàng ngàn cái :( Nhờ các bạn viết cho cái lisp chỉ cần kéo chuột một phát là OK. Mong các bạn giúp mình , cám ơn nhiều lắm

  9. Đã đăng · Trả lời báo cáo

    phần mềm này hinh như ko dùng trên cad 2007 hả bạn mình cài thử và làm như bạn hương dẫn nhưng ko thấy thanh công cụ đâu cả.chỉ cho mình cách dùng

    Đây là các file lisp, không phải phần mềm gì cả. Gõ menuload và load menu utility trong c:\Mylisp

    Mình mới cập nhật thêm vài trăm lệnh nữa, đặt biệt có các công cụ bản đồ( chạy đường đồng mức) , đang test, lúc nào xong sẽ đưa lên ngay

  10. Đã đăng · Trả lời báo cáo

    Chào thiep

    Nếu thiep sử dụng từ "san bằng" thì bài toán trở nên đúng đắn. Còn nếu không sử dụng từ "san bằng" thì point rất dễ nhận cao độ Z là Text của thằng "hàng xóm". Lisp TIMGAN của bác Hoành không thể áp dụng đúng trong trường hợp của bài toán không gian 3D trong trường hợp này. Phải nhờ tới điều kiện "san bằng để giải quyết.

    Tuy nhiên, nếu mà "san bằng" như vậy thì không thể Move các point về cao độ của điểm chèn Text được vì cao độ của điểm chèn Text và điểm chèn Point được đưa về mặt phẳng 0.0 rồi

     

    Đây là Lisp mà Tue_NV viết theo ý của thiep :

    1. "San bằng" độ cao của tất cả text cao độ và point về mặt phẳng 0.0

    2. Sử dụng hàm TIMGAN để tìm Text gần point nhất (vì có thể giữa point và Text có khoảng hở nhất định nào đó)

    3. Dựa vào nội dung của Text số : đây là độ cao -> theo ý của thiep : nâng cả text độ cao và point lên độ cao của nội dung text số

    Cảm ơn thiep đã gợi ý cho Tue_NV hoàn thành code này. Nếu có gì chưa đúng lắm các bạn có thể góp ý để mình chỉnh sửa lại. Thanks

     

    @ tnmtpc : Theo Tue_NV suy luận thì trước khi sử dụng Lisp mà Tue_NV đã viết thì bạn đã sử dụng cái Lisp di chuyển các text sao cho điểm chèn text trùng các point tương ứng rồi, để cho các point và Text trùng nhau rồi, phải không bạn tnmtpc? -> Cái Lisp đó cũng chính là bản chất của Lisp TIMGAN đấy.

     

    Đây là code mà Tue_NV đã viết lại theo ý kiến của bạn thiep

    (defun c:MPT(/ ss ss2 i j lis p p2 textgan entextgan Ztextgan ent entp 
	lay_point lay_txt)
;copyright by Tue_NV
(command "undo" "be")

(if (= (cdr (assoc 0 (entget 
(setq ename (car (entsel "\nChon Point de lay Layer chua POINT : ")))
	      ))) "POINT")
(setq lay_Point (cdr(assoc 8 (entget ename))))
)

(if (= (cdr (assoc 0 (entget 
(setq ename (car (entsel "\nChon TEXT de lay Layer chua TEXT : ")))
	      ))) "TEXT")
(setq lay_Txt (cdr(assoc 8 (entget ename))))
)

(setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 lay_txt))) 
i 0 j 0 lis (list) )
(setq ss2 (ssget "X" (list (cons 0 "POINT") (cons 8 lay_Point))) )
(ZO ss) (ZO ss2)

(while (< i (sslength ss))
(setq entp (entget (ssname ss i)) )
(setq p (cdr(assoc 10 entp)))
(setq lis (append lis (list p) )
)

(setq i (1+ i))
)

(while (< j (sslength ss2))
(setq ent (ssname ss2 j))
(setq p2 (cdr(assoc 10 (entget ent))))
(setq textgan (ssget "X" 
		(list 
		(cons 0 "TEXT") 
		(cons 8 lay_txt)
		 (cons 10 (timgan p2 lis)) 
		))) 
(setq entextgan (ssname textgan 0))
(if (distof 
	(cdr(assoc 1 (entget entextgan) )) 2)
	(setq Ztextgan 
	   (distof (cdr(assoc 1 (entget entextgan) )) 2)
	)
	(setq Ztextgan 0.0)
)
	(command "move" ent entextgan "" (list 0 0 (caddr p2)) 
				(list 0 0 Ztextgan)
	)
(setq j (1+ j))
)
(command "undo" "end")
)
;
(defun round(so tp)
(setvar "dimzin" 0)
(atof (rtos so 2 tp))
)
;
(defun ZO(ss / i ent po)
(setq i 0)
(while (< i (sslength ss))
	(setq ent (entget(ssname ss i)))
	(setq po (cdr(assoc 10 ent)))
	(entmod (subst (list 10 (car po) (cadr po) 0.0) 
			(assoc 10 ent) ent
		)
	)
	(setq i (1+ i))
)
)
;
(defun timgan	(p lst / dmin ppluu)
      (foreach pp lst
        (setq d (distance p pp))
        (if (or (not dmin) (> dmin d))
  	(setq dmin d
  	      ppluu pp
  	)
        )
      )
     ppluu
)

    Mình download lisp về chạy thấy báo lỗi, hơn nữa có bất tiện là nếu di chuyển cho dấu chấm thập phân của text trùng point thì thì point bị "đè" dưới text không chọn được. Mình thấy lisp trước tuy thêm một bước tùy chọn ZT< ZC nhưng cũng có cái hay của nó

  11. Đã đăng · Trả lời báo cáo

    Chào bạn tnmtpc'

    Lisp này Tue_NV đã hoàn thiện lại theo yêu cầu của bạn nè. Thử nhé : 

    (defun c:MPT(/ ss ss2 i j lis Z Z1 Z2 p p2 pkt ent entp L caoZ lay_point
	lay_txt ename ans)
;copyright by Tue_NV
(command "undo" "be")

(if (= (cdr (assoc 0 (entget 
(setq ename (car (entsel "\nChon Point de lay Layer chua POINT : ")))
	      ))) "POINT")
(setq lay_Point (cdr(assoc 8 (entget ename))))
)

(if (= (cdr (assoc 0 (entget 
(setq ename (car (entsel "\nChon TEXT de lay Layer chua TEXT : ")))
	      ))) "TEXT")
(setq lay_Txt (cdr(assoc 8 (entget ename))))
)

(setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 lay_txt))) 
i 0 j 0 lis (list) Z1 (list) Z2 (list))
(setq ss2 (ssget "X" (list (cons 0 "POINT") (cons 8 lay_Point))) )
(while (< i (sslength ss))
(setq entp (entget (ssname ss i)) )
(setq p (cdr(assoc 10 entp)))
(setq lis (append lis 
		(list (list (round (car p) 3) (round (cadr p) 3)) )
	  )
)
(setq Z1 (append Z1 (list (caddr p))))
(if (setq chu (distof (cdr(assoc 1 entp)) 2))
	(setq Z2 (append Z2 (list chu)))
)
(setq i (1+ i))
)
(initget "ZT ZC")
  (setq ans (getkword 
	"\n Move Z point ve ZTEXT / Move Zpoint ve Z la chu so cua TEXT : "
))
(if (= ans "ZT") (setq Z Z1) (setq Z Z2))
(while (< j (sslength ss2))
(setq ent (ssname ss2 j))
(setq p2 (cdr(assoc 10 (entget ent))))
(setq pkt (list (round (car p2) 3) (round (cadr p2) 3)) )
(if (setq L (member pkt lis))
	(progn 
		(setq caoZ (nth (- (length lis) (length L)) Z) )
		(command "move" ent "" (list 0 0 (caddr p2)) 
				        (list 0 0 caoZ)
		)
  	)
)
(setq j (1+ j))
)
(command "undo" "end")
)
;
(defun round(so tp)
(setvar "dimzin" 0)
(atof (rtos so 2 tp))
)

    Chào bạn thiep :

    Nếu sử dụng hàm TIMGAN của bác Hoành trong trường hợp bài toán này có lẽ rằng không được. Vì như thế sẽ dễ gán nhầm cao độ của TEXT "hàng xóm" cho POINT lắm. :cheers:

    Cảm ơn lời chúc của thiep. Thanks

    Vấn đề đã được giải quyết, cám ơn Tue_NV và các bạn rất nhiều

  12. Đã đăng · Trả lời báo cáo

    Cám ơn các bạn rẩt nhiều về sự quan tâm này, có một số ý mình nêu rõ hơn là: trong bản vẽ mẫu, các tên điểm t1, t2,...L8,L9.. đây là các "text chữ", gặp trường hợp tên điểm là 1,2,3... là Các "text số", sợ chương trình "đọc nhầm". Bản vẽ mẫu được tạo ra trên cơ sở nhập khẩu từ file ascii bằng lisp. Mình đang sưu tập một số lisp liên quan đến vẽ đường đồng mức, tạo bản đồ. các point giúp tạo ra lưới tam giác để nội suy bình đồ nhưng vì các point có z=0 nên bề mặt phẳng lì không có đường đồng mức nào được tạo ra cả. Lisp Gia-Bach giải quyết được vấn đề

    Đúng như duy782006 sẽ có trường hợp bản vẽ "chết lần 2", tất cả Z đều =0, như vậy vấn đề cần đặt ra thêm là yêu cầu lisp chuyển Z các points về đúng giá trị nội dung của text chứ không phải giá trị thuộc tính Z của text (vì tất cả các Z của text đều bằng 0) , mong các bạn giúp thêm yêu cầu này để giải quyết gọn vấn đề.

    Sau khi hoàn thành bộ sưu tập lisp về bản đồ, mình sẽ upload để các bạn làm trắc địa dùng chơi

  13. Đã đăng · Trả lời báo cáo

    Chào tnmtpc

    Bạn sử dụng Lisp này thử nhé : 

    (defun c:MPT(/ ss ss2 i j lis Z p p2 pkt ent L caoZ)
;copyright by Tue_NV
(setq ss (ssget "X" '((0 . "TEXT") (8 . "el"))) i 0 j 0 lis (list) Z (list))
(setq ss2 (ssget "X" '((0 . "POINT") )) )
(while (< i (sslength ss))
(setq p (cdr(assoc 10 (entget (ssname ss i)))))
(setq lis (append lis 
		(list (list (round (car p) 3) (round (cadr p) 3)) )
	  )
)
(setq Z (append Z (list (caddr p)))
)
(setq i (1+ i))
)
(while (< j (sslength ss2))
(setq ent (ssname ss2 j))
(setq p2 (cdr(assoc 10 (entget ent))))
(setq pkt (list (round (car p2) 3) (round (cadr p2) 3)) )
(if (setq L (member pkt lis))
	(progn 
		(setq caoZ (nth (- (length lis) (length L)) Z) )
		(command "move" ent "" '(0 0 0) 
				        (list 0 0 caoZ)
		)
  	)
)
(setq j (1+ j))
)
)
;
(defun round(so tp)
(setvar "dimzin" 0)
(atof (rtos so 2 tp))
)

    Cám ơn tue_NV nhiều lắm, đúng là cực nhanh, trúng ý mình rồi. Tue_NV có thể chỉnh sửa lại một chút để tiện cho người sử dụng thao tác, đề phòng trường hợp một point có hai text số khác nhau mà trong đó có một text không phải là giá trị độ cao. Cách thao tác như sau:

    nhập lệnh->yêu cầu chọn lớp chứa các point bằng cách chọn một point trên bản vẽ-> yêu cầu chọn lớp chứa các text độ cao bằng cách chọn một text độ cao -> enter

    Một lần nữa cám ơn tue_NV nhiều

  14. Đã đăng · Trả lời báo cáo

    Nhờ viết lisp:

    trên bản vẽ có các điểm tọa độ, mỗi điểm có nhãn tên điểm và nhãn độ cao đi liền với point nhưng các point có độ cao z=0, muốn chuyển các point về độ cao đúng của nó một cách nhanh nhất.

    Đây là file trước khi chuyển :

    http://www.cadviet.com/upfiles/2/cogopoint1_1.rar

    và đây là file sau khi chuyển:

    http://www.cadviet.com/upfiles/2/cogopoint2.rar

  16. Đã đăng · Trả lời báo cáo

    Từ lúc nói cái ý tưởng này viết trên lisp cho đến hiện nay thì cũng là một thời gian khá dài elleHCSC tiếp cận và để tâm tới viết bằng lisp trên CAD và cũng đã hoàn thành bước 1 nghĩa là đã nối được theo tên điểm mia trên màn hình. Chỉ oái oăm nhất là mình chưa tìm thấy cái edit_text dạng multi_line trên cad đâu cả...nên hiện giờ mỗi lần nối chỉ nhập số liệu được trên có 1 dòng lệnh (command line) nên hạn chế có 256 ký tự. Các bạn chờ 1 thời gian mình tìm hiểu thêm rồi public lên sau nha !

     

    http://www.cadviet.com/upfiles/2/noi_diem_video.rar

     

    Ngày cuối tuần vui vẻ !

    Nhập dữ liệu thông qua hộp thoại: hộp thoại có một editbox cho nhập vô tư mà bạn

  17. Đã đăng · Trả lời báo cáo

    wow thấy bác vbao hỏi thế này tôi mới biết bác cũng dùng cad để vẽ bình đồ. Câu hỏi của bác vì tôi ko viết được lisp nên chưa chắc đã có thể trả lời cũng như viết hay sửa code cho bác nhưng tôi cũng dùng cad để vẽ bản đồ nên có thể đóng góp cho bác 1 số ý kiến để bác tham khảo.

     

    Với đầu bài của vbao thì nên nhờ anh em trong diễn đàn viết theo cách thức sau:

     

    1. trên file vẽ CAD có các điểm text 001, 002, 003... 1, 2, 3 hay m1, m4,... gì đó (đại loại thế) chính là điểm mia và toạ độ điểm mia là toạ độ insert của điểm text.

    2. Yêu cầu tất cả các điểm text trên màn hình phải thuộc 1 layer (nên thế vì sẽ rất thuận tiện cho người lập trình) và điều này thì các user phải tự làm.

    3. Viết 1 đoạn chương trình để khi chạy CT đưa ra 1 hộp TEXT_BOX cho user nhập số liệu nối điểm (không nên nhập số liệu ở command line vì không nhập được nhiều điểm) theo mẫu sau :

     

    dòng 1 : 001 003 008 m2 m6 ==>> nối điểm 001 với 003, 003 với 008, 008 với m2, m2 với m6.

    dòng 2 : 001-017 ==>> nối từ điểm 001 đến 017.

    dòng 3 : 1-3 m2 006 ==>> nối từ điểm 1 đến điểm 3, nối điểm 3 với điểm m2, nối m2 với 006

    .......

    v.v...

     

    với cách thức nhập số liệu như trên thì ta có thể nối các điểm rất mềm dẻo và thuận tiện. Thuận tiện vì mỗi lần nhập bạn có thể nối được nhiều "khối" với mỗi "khối" là một dòng số liệu. Mềm dẻo vì ta chỉ cần nhập tên điểm còn CT sẽ lấy toạ độ của các TEXT trên Cad mà đôi lúc ko cần quan tâm mã code của điểm mia là gì.

    Bên tôi cũng dùng CAD để vẽ BD nhưng dùng 1 số chương trình ngoài cad (dos cũ thôi) để tính toán số liệu và xuất ra file DXF sau đó dùng file này để import vào CAD. Tuy nhiên cách thức nối thì theo như tôi đưa ra ở trên và anh em vẽ thấy khá thuận tiện. Tuy nhiên làm được trong cad thì rất thuận tiện và nhanh đấy.

    Yêu cầu này thiết thực, ứng dụng mạnh trong thành lập bản đồ. Sao không bác nào giúp một cái lisp như vậy nhỉ

  19. Đã đăng · Trả lời báo cáo 

    (defun c:pt()
(setq i 0 txt_pnt (ssget '((0 . "TEXT,point"))))
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(command "osmode" 0)
(repeat (sslength txt_pnt)
(setq txt_pnt_ent (entget (ssname txt_pnt i)))
(if (assoc 1 txt_pnt_ent)
(progn 
(setq txt_pt (cdr (assoc 10 txt_pnt_ent)) ii 0 kcmin 999999999999999999)
(while (< ii (sslength txt_pnt))
(setq txt_pnt_ent1 (entget (ssname txt_pnt ii)))
(if (assoc 1 txt_pnt_ent1) ()
(progn (setq pnt_pt (cdr(assoc 10 txt_pnt_ent1)) kci (distance txt_pt pnt_pt))
(if (< kci kcmin) (setq kcmin kci pnt_goc pnt_pt))
);progn
);if
(setq ii (+ ii 1))
);while
(command "move" (ssname txt_pnt i) "" txt_pt pnt_goc)
);progn
);if
(setq i (+ i 1))
);repeat
(setvar "osmode" oldos)
(command "undo" "end")
);defun

     

    Chú ý:

    - Khi chạy lisp này, với mỗi text lisp sẽ quyét tất cả các point để tìm point gần nhất và di chuyển text đến point đó. Chính vì thế có thể xảy ra trường hợp (rất ít xảy ra) 2 text có chung một point gần nhất, khi đó lisp sẽ di chuyển chúng trùng với nhau dẫn đến có thể một số point bị lạc mất text cao độ. bạn sử dụng chú ý một chút là OK.

    - Tên lệnh bạn có thể tự đổi cho phù hợp với nhu cầu.

    - Vì viết nhanh nên mình chỉ quan tâm đến hiệu quả, không quan tâm đến chất lượng nên lisp này nói chung là không hay lắm dưới con mắt người lập trình, vài chỗ cách làm hơi củ chuối nhưng với người sử dụng thì OK không vấn đề gì. hi vọng đúng ý bạn. :tongue2:

    Bạn xem lại giúp, load lisp, gõ lệnh, báo lỗi "; error: too many arguments"

    Mình dùng Cad 2004

  20. Đã đăng · Trả lời báo cáo

    trước đây Bác Hòanh có viết một lisp " di chuyển dấu chấm thập phân text đến trùng với point tương ứng". Nay nhờ các bạn viết lisp di chuyển các text sao cho điểm chèn text trùng các point tương ứng. Cụ thể như sau: bản vẽ có nhiều text, mỗi text có một point tương ứng nằm gần text, vị trí text so với point hơi tự do một chút, nghĩa là vị trí text so với point không phải lúc nào cũng bằng nhau. Yêu cầu chương trình: sau khi gõ lệnh, chọn tất cả text và point một lúc, enter, lệnh thực hiện.

    Cám ơn trước .

    không Bác nào giúp mình cái này à??

  21. Đã đăng · Trả lời báo cáo

    trước đây Bác Hòanh có viết một lisp " di chuyển dấu chấm thập phân text đến trùng với point tương ứng". Nay nhờ các bạn viết lisp di chuyển các text sao cho điểm chèn text trùng các point tương ứng. Cụ thể như sau: bản vẽ có nhiều text, mỗi text có một point tương ứng nằm gần text, vị trí text so với point hơi tự do một chút, nghĩa là vị trí text so với point không phải lúc nào cũng bằng nhau. Yêu cầu chương trình: sau khi gõ lệnh, chọn tất cả text và point một lúc, enter, lệnh thực hiện.

    Cám ơn trước .

  22. Đã đăng · Trả lời báo cáo

    Mình thử diễn đạt lại ý của bạn thế này xem có đúng không nhé.

    Bạn có một hình đa giác bất kỳ với n cạnh.

    bạn muốn một lisp có chức năng:

    - pick lần lượt vào các đỉnh của da giác đó lần lượt theo một chiều nhất định (cùng chiều hoặc ngược chiều kim đồng hồ)

    - Lisp sẽ đánh số thứ tự các điểm đã pick.

    - Xuất một bảng thống kê như bản vẽ thứ nhất của bạn gồm: tọa độ (X,Y) của các đỉnh; chiều dài các cạnh giữa 2 đỉnh kề nhau.

    Trước đây đã có một bạn nhờ mình làm việc này (tại đây, bài số 14) nhưng bạn ấy diễn đạt khiến mình không thể hiểu. giờ nhìn vào bản vẽ thứ nhất của bạn nên mình lờ mờ đoán ra. ko biết có fải ý của bạn không.

    Có thể diễn đạt như sau:

    có một bản đồ địa chính hoàn chỉnh, thửa đất được tạo bỡi các polyline kín, trong thửa đất có các thông tin: loại đất, số hiệu thửa đất, diện tích. cần tạo ra file hồ sơ kỹ thuật thửa đất cho mỗi thửa đất (file sơ đồ trích đo thửa đất). Yêu cầu chương trình lisp:

    Trên bản đồ địa chính, chọn thửa đất cần tạo hồ sơ kỹ thuật, chương trình sẽ mở file mẫu hố sơ kỹ thuật, chèn thửa đất vừa chọn vào giữa khung, tự động đánh số đỉnh thửa, tạo bảng kê phía dưới phải của khung, các nội dung text khác có sẵn trên file mẫu hoặc do người sử dụng nhập vào

    Hy vọng đúng ý bạn trang7889

    • Like 1
    • Vote tăng 1

  24. Đã đăng · Trả lời báo cáo

    Lệnh ko dùng được lệnh dùng được bác tnmtpc

    VD: mình bấm nút lệnh thì

    Command: GT_Tube (lệnh vẽ ống)

    Unknown command "GT_TUBE". Press F1 for help.

     

    Command: GT_Slot (lệnh vẽ rãnh)

    Unknown command "GT_SLOT". Press F1 for help.

    2 Lệnh này Ko hoạt động, như phần trên tnmtpc đã nêu, mấy anh cracker tạo file geoT.vlx không "sạch", nên một số lệnh Ko có. Tnmtpc đang tút lại bản dịch, trong quá trình tút, mình sẽ kiểm tra lại từng lệnh

    • Vote tăng 2
×