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

Viết Lisp theo yêu cầu

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

Em có 1 file có rất nhiều text trùng lên nhau, làm bản vẽ nặng lên. Xin nhờ mọi người và anh Tue_NV viết hộ 1 lisp xóa các text trùng lên nhau (cách thức như dùng lệnh overkill vậy). 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
Em có 1 file có rất nhiều text trùng lên nhau, làm bản vẽ nặng lên. Xin nhờ mọi người và anh Tue_NV viết hộ 1 lisp xóa các text trùng lên nhau (cách thức như dùng lệnh overkill vậy). Thanks!

Ôi chị Svba! Làm sao chị biết được file có nhiều text trùng nhau???

 

Cái gì trùng nhau cúng xóa được hết chị ạ!

Chưa mở bản vẽ của anh nhưng em đoán bản vẽ có nhiều nét trùng nhau .Sau PU anh thử thêm cách sau xem:

Express => Modify => Delete duplicate objects => Chọn tất cả các đối tượng vẽ => Enter để xoá các nét vẽ trùng nhau.

Nếu ko xóa được chị upload file bản vẽ đó lên...để em đưa vào mục.... đố vui:

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

  • Vote tăng 2

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
Ôi chị Svba! Làm sao chị biết được file có nhiều text trùng nhau???

Cái gì trùng nhau cúng xóa được hết chị ạ!

Nếu ko xóa được chị upload file bản vẽ đó lên...để em đưa vào mục.... đố vui:

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

 

Cảm ơn chị nhưng cách của chị em đã dùng rồi mà không được, nó không xóa được text:

Express => Modify => Delete duplicate objects => Chọn tất cả các đối tượng vẽ => Enter để xoá các nét vẽ trùng nhau = Overkill

File đó đây chị thử xem giùm xem: phần khung tên hầu như tất cả các chữ đều có đúng 16 text trùng lên nhau.

(Tiện thể chị xem và góp ý cho em cái bố trí đường ống với :s_dead: ).

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 có 1 file có rất nhiều text trùng lên nhau, làm bản vẽ nặng lên. Xin nhờ mọi người và anh Tue_NV viết hộ 1 lisp xóa các text trùng lên nhau (cách thức như dùng lệnh overkill vậy). Thanks!

Bạn dùng tạm cái này

;Ham xoa text trung nhau
(defun C:XOATEXTTRUNG( / ss lis i ds p st ss1)
 (defun diem( name n)
(cdr (assoc n (entget name)))
 )
 (setq lis nil)
 (setq ss (ssget '((0 . "text,mtext"))))
 (if ss (progn
(setq i 0)
(setq ss1 (ssadd))
(while (< i (sslength ss))
  (setq name (ssname ss i))
  (setq p (diem name 11) st (diem name 1))
  (if (equal p '(0.0 0.0 0.0)) (setq p (diem name 10)))
  (if lis
	(progn
	  (setq ds (assoc p lis))
	  (if (and ds (= st (cadr ds)))
		(ssadd name ss1)
		(setq lis (append lis (list (list p st))))
	  )
	)
	(setq lis (list (list p st)))
  )
  (setq i (1+ i))
)
 ))
 (if (> (sslength ss1) 0) (command "_.erase" ss1 ""))
)

  • Vote tăng 2

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 dùng tạm cái này

Lisp rất tuyệt vời. Vô cùng cảm ơn bác! :s_dead: Tuy nhiên chỉ dùng được với 1-2 text cùng lúc, còn quét cả cái khung tên thì không được. Nhưng như thế này cũng là tuyệt vời lắm rồi.

 

Ôi! Chị Svba! Quả thực em ko tin chị đã nghĩ ra "mẹo" này (!)

Đố các bác biết chị Svba đã "nghĩ ra" "mẹo" gì???

Đến em cũng chẳng biết em nghĩ ra mẹo gì nữa. Đúng là đố vui thật! :s_dead:

(Còn về việc em biết có 16 text trùng lên nhau là do người làm khung tên bảo và em cũng xóa thủ công, vừa xóa vừa ... đếm).

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
Lisp rất tuyệt vời. Vô cùng cảm ơn bác! :s_dead: Tuy nhiên chỉ dùng được với 1-2 text cùng lúc, còn quét cả cái khung tên thì không được. Nhưng như thế này cũng là tuyệt vời lắm rồi.

Đến em cũng chẳng biết em nghĩ ra mẹo gì nữa. Đúng là đố vui thật! :s_dead:

(Còn về việc em biết có 16 text trùng lên nhau là do người làm khung tên bảo và em cũng xóa thủ công, vừa xóa vừa ... đếm).

 

Muốn biết nó có bao nhiêu text chị chỉ việc chọn đối tượng rồi gõ lệnh (....) biết liền cái này em đã từng ra câu đố ở trang 13 mục đố vui và quên chưa đưa ra lời giải tiện đây em cũng đố luôn làm thế nào để biết được số lượng text ???

CÔNG TRÌNH: PHÂN TRẠI GIAM SỐ 4 - TRẠI GIAM SỐ 3

HẠNG MỤC NHÀ LÀM VIỆC

 

Cả cụm từ trên có 49 text trong đó từ HẠNG MỤC chỉ có 1 text!

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
Tuy nhiên chỉ dùng được với 1-2 text cùng lúc, còn quét cả cái khung tên thì không được.

Cái file của bạn với những text trùng sau nhưng tọa độ lệch 1, 2 số cuối làm cho lệnh của cad tìm kg ra. Bạn chỉ nên dùng tạm líp sau chứ kg nên dùng cho nhiều file khác

Bạn dùng tạm cái này

;Ham xoa text trung nhau
(defun C:XOATEXTTRUNG( / ss lis i ds p st ss1)
 (defun diem( name n)
(cdr (assoc n (entget name)))
 )
 (setq lis nil)
 (setq ss (ssget '((0 . "text,mtext"))))
 (if ss (progn
(setq i 0)
(setq ss1 (ssadd))
(while (< i (sslength ss))
  (setq name (ssname ss i))
  (setq p (diem name 10) st (diem name 1))
			  (setq p (strcat (rtos (/ (car p) 100.0) 2 0) (rtos (/ (cadr p) 100.0) 2 0)))
  (if lis
	(progn
	  (setq ds (assoc p lis))
	  (if (and ds (= st (cadr ds)))
		(ssadd name ss1)
		(setq lis (append lis (list (list p st))))
	  )
	)
	(setq lis (list (list p st)))
  )
  (setq i (1+ i))
)
 ))
 (if (> (sslength ss1) 0) (command "_.erase" ss1 ""))
)

  • Vote tăng 2

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

Các bác ơi giúp em với! loai hoai từ tối tới giờ mà vẫn không làm dc. các bác đừng cười em nhé...hihi

Em đã thực hiện appload chương trình "scale block và text theo điểm chèn đối tượng" và có kết quả:SB.lsp successfuly loader

Khi gõ lệnh SB trên dong command C.Trình báo lỗi " error: no function definition" em phải làm sao bây giờ...

thank you very much!

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
Cái file của bạn với những text trùng sau nhưng tọa độ lệch 1, 2 số cuối làm cho lệnh của cad tìm kg ra. Bạn chỉ nên dùng tạm líp sau chứ kg nên dùng cho nhiều file khác

Bạn dùng tạm cái này

Chào svba1608

Tue_NV đã hoàn thiện đoạn Code này khắc phục được nhược điểm của Lisp của Bạn TRUNGNGAMY và có thể áp dụng được cho tất cả mọi bản vẽ.

svba thử nhé :

Code đây. Cách thức hoạt động y như Overkill (cho phép nhập khoảng sai số giữa các text trùng nhau)

Enter Numeric fuzz :

(defun C:XTT(/ ss ss1 fuzzo fuzz n ent p ndung ent1 ndung1)
(prompt "\n Chon Text,MTEXT : ")
   (setq ss (ssget '((0 . "text,mtext"))) n (sslength ss))
(if (null fuzzo) (setq fuzzo 20))
(setq fuzz (getreal (strcat "\n Enter Numeric fuzz  : ")))
(if (null fuzz) (setq fuzz fuzzo) (setq fuzzo fuzz))

    (setq ss1 (ssadd))

    (while (> n 0)

      (setq ent (ssname ss 0))

      (setq p (cdr(assoc 10 (entget ent))))
(setq ndung (cdr(assoc 1 (entget ent))) i 1)

(while (
(setq ent1 (ssname ss i))

      (setq p1 (cdr(assoc 10 (entget ent1))))
(setq ndung1 (cdr(assoc 1 (entget ent1))))
(if (and (equal p p1 fuzz) (eq ndung ndung1))
(progn
(setq ss1 (ssadd ent1 ss1))
);progn
);if
(setq i (1+ i))

);while

(setq ss (ssdel ent ss))
(setq n (sslength ss))


)


(if (> (sslength ss1) 0) (command "_.erase" ss1 ""))
(princ)
)

  • Vote tăng 2

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 Hoanh ơi cho em hỏi:

+ có thể đưa một số thuộc tính của đối tượng trên bản vẽ vào cơ sở dữ liệu của chính bản vẽ đó được không?

+ Nếu có thể, Bác viết cho C.trình "tạo bảng nhập dữ liệu cho đối tượng được chọn trên màn hình"

Ví dụ: chon đối tượng nhà. cần nhập các thuộc tính:

địa chỉ: số nhà, ngõ, phố, phường(xã), quận(huyện), tỉnh(thành phố)

loại nhà: nhà trung cư, nhà riêng, nhà vườn ...

kiểu kiến trúc: nhà mái bằng, mái ngói, số tầng...

diện tích thực tế:....

giá trị bằng tiền:

thời điểm nhập dữ liệu: giờ... ngày/tháng/ năm

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âng, sẽ có nhiều loại đối tượng. xong mỗi đối tượng chỉ có vài thuộc tính (không quá 10). các thông tin đều ngắn gọn chỉ mang tính thống kê...

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

Cảm ơn ban Tue_NV nhiều nhá.

Cái lisp ấy của mình vẫn còn nhiều lỗi lắm. Bạn có biết cách nào tìm lỗi trong Visual lisp không. Giống thằng pascal ấy.

Cảm ơn bạn nhiều 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
Trước khi chạy Lisp -> Conghoan đánh lệnh trim -> và thiết lập như sau :

Command: trim

 

Select objects: Specify opposite corner: 1 found : chọn đối tượng

 

Select objects: Enter

 

Select object to trim or shift-select to extend or [Project/Edge/Undo]: e : gõ e

Enter an implied edge extension mode [Extend/No extend] : e gõ e

Select object to trim or shift-select to extend or [Project/Edge/Undo]:

-> rồi sau đó mới sử dụng lệnh VBUN

Hy vọng bạn thành công :s_dead:

-> Conghoan sử dụng giải pháp này xem sao

Cái này mình cũng đã thử rồi nhưng vẫn không có tác dụng gì. Mình đang dùng cad 2007 liệu có ảnh hưởng gì không Tuê_NV. Hình như Tuê_NV dùng lệnh trim để nối nó lại với nhau à? Tuệ_NV có thể chuyển sang dùng lệnh fillet (với R=0) được không? phải thử giải pháp này thế nào chứ Tuê_NV "bó tay" thì mình cũng "bó chân" luôn. Thấy cái này hay thế mà chưa sử dụng được thấy tiết quá. Tuệ cố gắng giúp mình lần nữa nhé. Thank a lot!

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
Các bác ơi giúp em với! loai hoai từ tối tới giờ mà vẫn không làm dc. các bác đừng cười em nhé...hihi

Em đã thực hiện appload chương trình "scale block và text theo điểm chèn đối tượng" và có kết quả:SB.lsp successfuly loader

Khi gõ lệnh SB trên dong command C.Trình báo lỗi " error: no function definition" em phải làm sao bây giờ...

thank you very much!

Chào bạn Khibeo,

Bạn hãy mở file lisp ra kiểm tra lại xem tên lệnh có phải là SB không nhé. Nếu không phải thì bạn có gõ cả ngày cũng vẫn vậy thối. Vì chả biết file lisp của bạn ra sao nên chả thể trả lời bạn rõ hơn. Nếu được bạn hãy upload file lisp đó lên 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 ơi, em.....hix, lisp này bác đã dùng đc chưa ah? Em pick vào vùng đầu tiên thì báo lỗi thế này: ; "error: bad argument type: lselsetp nil". Bác xem lại rùi sửa júp em đc hôk ah? Cám ơn bác.Bác jữ sk để viết nhìu nhìu lisp hay cho bọn em na! hjj

Tue_NV không hiểu sao bạn test Lisp bị lỗi trong khi đó Tue_NV test OK

Tue_NV có chỉnh lại Lisp một chút. Bach1212 test thử xem.

Hy vọng bạn thành công

(defun c:gdt(/ oldim p1 frome cur toe ss ss2 tt S ans po cao te ente)
(setq oldim (getvar "DimZin"))
(setvar "DimZin" 0)
(setvar "cmdecho" 0)
(setq p1 (getpoint "\n Pick diem vao mien de lay dien tich : ") S 0 ss2 (ssadd))
(While p1
(setq frome (entlast));; 

(command ".boundary" p1 "");; boundary
(setq toe (entlast));; 

(setq cur frome; khoi tao
ss (ssadd)
)
(while (not (eq cur toe));; 
(setq
cur (entnext cur)
ss (ssadd cur ss)
)

(command "list" ss "")
(graphscr)
(setq tt (getvar "area"))
(setq S (+ S tt))
)

(Command "erase" ss "")
(setq p1 (getpoint "\n Pick diem vao mien de lay dien tich : "))

)
(initget "T C")
(setq ans (getkword "\n Chon Text  de thay gia tri dien tich / chon diem chen  de ghi dien tich  :"))
(if (or (= ans "c") (= ans "C"))
(progn
(setq po (getpoint "\n Chon diem chen de ghi dien tich :"))
(setq cao (getdist "\n Nhap chieu cao chu : "))
(wtxt (rtos S 2 2) po 0 cao)
(command "erase" ss2 "")
)
)
(if (or (= ans "t") (= ans "T"))
(progn
(setq te (car(entsel "\n Chon Text de thay gia tri dien tich ")))
(setq ente (entget te))
(setq ente (subst(cons 1 (rtos S 2 2)) (assoc 1 ente) ente))
(entmod ente)
(command "erase" ss2 "")
)
)
(setvar "DimZin" oldim)
(Princ)
)
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) 
(cons 72 2) (cons 73 2) (cons 50 ang) (cons 40 h) (cons 41 0.8))
)
)

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 làm bên quy họach. Em đã load lisp tính diện tích và chèn giá trị vào vòng tròn ký hiệu. Rất hay nhưng có tới 3 biến là tên lô, diện tích và dân số. Em đang cần gấp lisp tương tự nhưng chỉ có hai biến thôi là tên lô và diện tích. Ngòai ra có thể chọn kiểu hình vuông hoặc hình tròn ký hiệu.

 

Anh chị nào có rồi thì cho em xin nhé. Nếu không nhờ mọi người viết hộ vì em không biết viết lisp. Cảm ơn nhiều nhiều. Em cần gấp lắm ạ. :s_dead: :s_dead: :s_dead:

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 làm bên quy họach. Em đã load lisp tính diện tích và chèn giá trị vào vòng tròn ký hiệu. Rất hay nhưng có tới 3 biến là tên lô, diện tích và dân số. Em đang cần gấp lisp tương tự nhưng chỉ có hai biến thôi là tên lô và diện tích. Ngòai ra có thể chọn kiểu hình vuông hoặc hình tròn ký hiệu.

 

Anh chị nào có rồi thì cho em xin nhé. Nếu không nhờ mọi người viết hộ vì em không biết viết lisp. Cảm ơn nhiều nhiều. Em cần gấp lắm ạ. :s_dead: :s_dead: :s_dead:

Chào bạn thai_nguyen

Chưa hiểu ý của bạn. Bạn nói hai biến thôi là tên lô và diện tích. có phải là bạn đang nói tới Attribute

Nếu bạn đang nói tới Attribute thì đấy không phải là biến bạn à.

Bạn có thể upload cái file mà bạn cần lên và nói rõ điều bạn muốn nhé.

Bạn nói rõ cách thức tính diện tích luôn nhé. (tính diện tích bằng cách pick điểm hay là tính diện tích bằng cách khác)

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
Cac Bac giup Em với, làm sao để có thể sửa được cái lisp này.

http://www.cadviet.com/upfiles/TRAC_DOC_CAP_NUOC_HUNG_.fas

Em sửa mà không được.

Hì hì, bác này chơi khó quá,

Nếu bác muốn sửa thì phải mở no ra xem trong đó người ta viết cái gì rồi mới sửa được chớ, đằng này bác cho mọi người cái file .fas này thì quá là đánh đố nhau bác ạ. Bác có cách nào mở được file .fas thì mách anh em với. Hoặc giả bác gửi file .lsp gốc lên xem thế nào chứ kiểu này thì bó giò rồi bác ạ.

Cầu mong bác có được các cao thủ trợ giúp. Chúc bác thành cô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

Em dung Nova4.0 trên nền CAD14, nhờ các bác giúp em với.

Khi thiết kế cắt ngang tuyến, em phải thực hiện nhiều lần lệnh TL, rất mất công. Em muốn hỏi các bác xem có thể lập lisp để xử lý vụ này không.

Ví dụ, bình thường trong Nova em phải làm thế này:

Command: tl

Chän lÒ hoÆc mÆt phÝa cÇn t¹o taluy:

Select object:

Undo/:0.4

 

§é dèc %<100.00>:100

 

Undo/:0.4

 

§é dèc %<100.00>:0

 

Undo/:0.4

 

§é dèc %<0.00>:-100

 

Undo/:6

 

§é dèc %<-100.00>:-133.33

 

Undo/:1.5

 

§é dèc %<-133.33>:4

 

Undo/:6

 

§é dèc %<4.00>:-100

 

Undo/:

 

Em định lập lisp như sau:

(defun c:4()
 (setq dtuong (car(entsel)))
 (command "TL" dtuong 0.4 100 0.4 0 0.4 -100 8 -133.33 1.5 4 6 -100 "")
 ); ve taluy co ranh, 1/0.75, co, 1/1

nhưng mà khi chạy thì Nova không nhận dữ liệu nhập. Các bác gỡ cho em vụ này 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
Em dung Nova4.0 trên nền CAD14, nhờ các bác giúp em với.

Khi thiết kế cắt ngang tuyến, em phải thực hiện nhiều lần lệnh TL, rất mất công. Em muốn hỏi các bác xem có thể lập lisp để xử lý vụ này không.

Ví dụ, bình thường trong Nova em phải làm thế này:

Command: tl

Chän lÒ hoÆc mÆt phÝa cÇn t¹o taluy:

Select object:

Undo/:0.4

 

§é dèc %<100.00>:100

 

Undo/:0.4

 

§é dèc %<100.00>:0

 

Undo/:0.4

 

§é dèc %<0.00>:-100

 

Undo/:6

 

§é dèc %<-100.00>:-133.33

 

Undo/:1.5

 

§é dèc %<-133.33>:4

 

Undo/:6

 

§é dèc %<4.00>:-100

 

Undo/:

 

Em định lập lisp như sau:

(defun c:4()
 (setq dtuong (car(entsel)))
 (command "TL" dtuong 0.4 100 0.4 0 0.4 -100 8 -133.33 1.5 4 6 -100 "")
 ); ve taluy co ranh, 1/0.75, co, 1/1

nhưng mà khi chạy thì Nova không nhận dữ liệu nhập. Các bác gỡ cho em vụ này với.

Đoạn code trên chỉ chạy được với Nova 2xxx còn đối với r14 thì mình đã thử và đã động chạm đến cả Xdata của nó nhưng vẫn ko ăn thua. Có thể giải quyết nhanh hơn 1 chút bằng cách "bán scrips" là

Command: tl

Chän lÒ hoÆc mÆt phÝa cÇn t¹o taluy:

Select object:

Undo/:0.4 100 0.4 0 0.4 -100 6 -133.33 1.5 4 6 100

Bạn lưu dòng 0.4 100 0.4 0 0.4 -100 6 -133.33 1.5 4 6 100 trong 1 file .txt nào đó (mỗi loại taluy sẽ có một list khác nhau) và nếu động đến loại taluy nào thì copy dòng đó vào dòng nhắc command thôi.

Mình mới chỉ nghĩ ra cách này . Ai biết cách nào hay hơn thì xin chỉ giáo.

  • 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 các bạn !

Mình xin nhờ các bạn một chuơng trình sau:

Cho hai đường polyline song song cánh nhau một khoảng cho trước. (D=10)

Yêu cầu:

Vẽ một đường POLYLINE nằm giữa hai đường thẳng cho trước đó. Chiều dài của MIN của mỗi đọan của đuờng POLYLINE đó lớn hơn một giá trị cho trước (ví dụ là 70m).

Rất mong các bạn giúp đỡ.

File bản vẽ gửi kèm.

http://www.cadviet.com/upfiles/duongthang.zip

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 các bạn !

Mình xin nhờ các bạn một chuơng trình sau:

Cho hai đường polyline song song cánh nhau một khoảng cho trước. (D=10)

Yêu cầu:

Vẽ một đường POLYLINE nằm giữa hai đường thẳng cho trước đó. Chiều dài của MIN của mỗi đọan của đuờng POLYLINE đó lớn hơn một giá trị cho trước (ví dụ là 70m).

Rất mong các bạn giúp đỡ.

File bản vẽ gửi kèm.

http://www.cadviet.com/upfiles/duongthang.zip

 

chỉ cần nằm bên trong 2 biên thôi sao, k co qui định gì khác hả?

nếu 2 đg biên gấp khúc quá thì làm sao đủ 70?

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.

×