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

Bảng xếp hạng


Nội dung phổ biến

Hiển thị nội dung có danh tiếng cao nhất vì 22/09/2021 trong Bài đăng

  1. 3 điểm
    File nguồn ở đây cho ai thích vọc ArrayDonhuongs.rar
  2. 2 điểm
    (defun c:test (/ A LS OBJ ss ) (setq ss (mapcar '(lambda (x) (vlax-ename->vla-object x)) (ACET-SS-TO-LIST (ssget '((0 . "INSERT")))) )) (foreach obj ss (progn (setq color (vla-get-color obj) ls (vlax-safearray->list (vlax-variant-value (vla-Explode obj))) ) (foreach n ls (if (= (vla-get-color n) 0) (vla-put-color n color)) ) (vla-Erase obj) ) ) )
  3. 2 điểm
    Chủ yếu lấy thể tích thôi mà. (defun c:khoiluong ( / DENSITATE KL MAT RO SS1 STR VOL X) (initget "S A C B Z T L N") (initget "Steel Aluminium Copper Brass Zinc Tin Lead Nickel" ) (setq densitate (getkword "\nChoose material Aluminium/Copper/Brass/Zinc/Tin/Lead/Nickel/<Steel>:" ) ) (cond ((or (= densitate "Aluminium") (= densitate "A")) (setq ro 2.70) (setq mat "Aluminium") ) ((or (= densitate "Copper") (= densitate "C")) (setq ro 8.93) (setq mat "Copper") ) ((or (= densitate "Brass") (= densitate "B")) (setq ro 8.80) (setq mat "Brass") ) ((or (= densitate "Zinc") (= densitate "Z")) (setq ro 7.14) (setq mat "Zinc") ) ((or (= densitate "Tin") (= densitate "T")) (setq ro 7.29) (setq mat "Tin") ) ((or (= densitate "Lead") (= densitate "L")) (setq ro 11.34) (setq mat "Lead") ) ((or (= densitate "Nickel") (= densitate "N")) (setq ro 8.86) (setq mat "Nickel") ) (T (setq ro 7.85) (setq mat "Steel") ) ) (setq ss1 (ACET-SS-TO-LIST(ssget))) (if (= ss1 nil) (exit) ) (setq ss1 (mapcar '(lambda (x) ( vlax-ename->vla-object x)) ss1) ) (setq vol 0) (foreach n ss1 (if (= (vla-get-Objectname n) "AcDb3dSolid") (setq vol (+ vol (vla-get-Volume n))) ) ) ;;;he so chuyen mm3 sang m3 (setq vol (* vol 0.0000001)) (setq kl (* vol ro)) (setq str (strcat "Vat lieu: \t" mat "\nKhoi luong rieng: \t" (rtos ro 2 2) " t/m3" "\nThe tich: \t" (rtos vol 2 3) " m3" "\nKhoi luong: \t" (rtos kl 2 3) " tan" ) ) (alert str) )
  4. 2 điểm
    Sau khi đọc lại các dòng chỉnh sửa của bác @alisp và bác @NTHAHT, E đã thử thêm trên lệnh cad và xử lý được lỗi, lisp đã chạy bình thường. Tks 2 bác vì đã giúp đỡ, không có 2 bác thì e còn loay hoay không ra được
  5. 2 điểm
    (setq ss (ssget '((0 . "LWPOLYLINE")))) (setq ss (ACET-SS-TO-LIST ss)) (if (< (length ss) 2) (exit)) (setq pl1 (car ss) pl2 (cadr ss)) (setq ls1 (ACET-GEOM-PLINE-POINT-LIST pl1 0) ls2 (ACET-GEOM-PLINE-POINT-LIST pl2 0) pl1s (car ls1) pl1e (last ls1) pl2s (car ls2) pl2e (last ls2)) (setq p3 (if (< (distance pl1s pl2s) (distance pl1e pl2s)) pl1s pl1e) ) (setq p4 (if (< (distance pl2s pl1s) (distance pl2e pl1s)) pl2s pl2e) ) (setq line1 (entmakex (list (cons 0 "line") (cons 10 p3) (cons 11 p4)))) (command "pedit" pl1 "join" line1 pl2 "" "")
  6. 2 điểm
    Em cũng chẳng biết nói sao nữa. Em cũng tham gia diễn đàn từ lâu, từ ngày mới đi học. Ngày đó, khi mới dùng CAD, em cũng hay vào hỏi linh tinh, nhờ cái nọ, cái kia. Hồi đó các anh trên diễn đàn rất nhiệt tình, giúp đỡ rất vô tư theo kiểu lấy đó làm niềm vui. Em cũng bắt đầu học viết lisp nhưng vì nhu cầu công việc không cần nhiều nên bỏ dở. Giờ chỉ thỉnh thoảng vào hỏi khi cần. Em công nhận là em rất bất lịch sự khi không trả lời cmt của anh LuytBui. Nhưng không phải em không biết quý trọng thời gian hay công sức của người khác. Hiện tại em đang dùng khá nhiều phần mềm hoặc công cụ bản quyền dù có rất nhiều lựa chọn free hay crack. Có lẽ tại em thấy không quen vì giờ diễn đàn hình như cái gì cũng quy ra... cơm gạo. Có thể anh thấy... buồn cười, nhưng thực sự là em cảm thấy thế. Có gì sai mong anh chỉ bảo thêm! PS: Em cũng định ib anh quocmanh04tt vì chưa hiểu ý anh sao lại đăng đoạn clip lên mà không nói gì thêm. Nhưng anh nói thế này thì ib cũng hơi... ngượng.
  7. 1 điểm
    Assoc Array 1 chiều với 2 lựa chọn số lượng hoặc khoảng cách để cho mình có thêm lựa chọn ArrayDonhuong.rar
  8. 1 điểm
    Diễn đàn CadViet hình như đó là sân chơi của Lisp thì phải, có lẽ đúng thật! -_- .Anh em vô đây đa số là yêu cầu Lisp chứ VBA thì rất ít.Vì vậy mình mạo muội thành lập cái chủ đề này mong rằng sẽ khuấy đảo được những anh em có lòng đam mê với VBA và đặc biệt là VBA cho Autocad. Những anh em nào mới học VBA hoặc đã có kiến thức về nó hãy mạnh dạn trao đổi để anh em cùng học hỏi nhé! Chúc Topic VBA cho Cad ngày càng phát triển. Chúc mọi người luôn vui vẻ!
  9. 1 điểm
    Nó dùng để đo dài , không phải đo góc nên không thể hướng tâm được. Nếu hướng tâm thì khoảng cách giữa 2 mút Extension line sẽ ngắn hơn Dimension line. Dùng một đoạn lớn hơn 330mm không rõ bao nhiêu lần để biểu diễn 330mm không có ý nghĩa gì.
  10. 1 điểm
    Sửa lại cho bạn nhưng kết quả nó phụ vẫn phụ thuộc vào khoảng cách text và tâm vòng tròn nhé (defun c:GTEXT (/ luubatdiem spc tapchon tapdiem lstss text gtricaodo phannguyen p1 phapphan gtridien diemtam) (command "undo" "BE") (setq luubatdiem (getvar "osmode")) (setvar "osmode" 0) (setvar "CMDECHO" 0) ;;;;;;;;;;;;;;;;;;;;;;; (setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object)))) (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") (setq h (getreal "\nNhap cao chu:")) (prompt "\nchon tap diem Point Text") (setq tapchon (acet-ss-to-list (ssget (list (cons 0 "CIRCLE"))))) (setq tapdiem (vl-remove-if-not '(lambda (x) (= (cdr (assoc 0 (entget x))) "CIRCLE")) tapchon)) ;(setq lstss (vl-remove-if-not '(lambda (x) (= (cdr (assoc 0 (entget x))) "TEXT")) tapchon)) (foreach ent tapdiem (setq p1 (cdr (assoc 10 (entget ent)))) (setq p2 (polar p1 (* 3 (/ pi 4)) 3)) (setq p3 (polar p1 (* 1 (/ pi -4)) 3)) (vla-ZoomCenter (vlax-get-acad-object) (vlax-3D-point p1) 200) (setq lstss (acet-ss-to-list (ssget "C" p2 p3 (list (cons 0 "TEXT"))))) (setq text (timtext p1 lstss)) (if text (progn (setq gtricaodo (vl-sort (list (cadr text) (caddr text)) '(lambda(x y) (< (car (car x)) (car (car y)))))) (setq phannguyen (cdr (car gtricaodo))) (setq phapphan (cdr (cadr gtricaodo))) (setq gtridien (strcat phannguyen "." phapphan)) (setq diemtam (car text)) (vla-put-Layer (vla-addtext spc gtridien (vlax-3d-point diemtam) h) "Caodo") ) ) ) (setvar "osmode" luubatdiem) (setvar "CMDECHO" 1) (command "undo" "End") )
  11. 1 điểm
    Mình xét khoảng cách min đến tâm vòng tròn nên sẽ có 1 số trường hợp text điểm này nhưng gần vòng tròn điểm kia với lại với tập điểm lớn như file bạn gửi sẽ chạy mất nhiều thời gian (Do trình chỉ xử lý được đến này thôi) Giải pháp chọn từng vùng để chạy Bạn dùng tạm cái này nhé! (defun timtext (point lsttext /) (setq lstcaodo (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lsttext)) (setq kcminpoint (vl-sort lstcaodo '(lambda(x y / tmx tmy) (setq tmx (distance (list (car (car x)) (cadr (car x)) 0) point) tmy (distance (list (car (car y)) (cadr (car y)) 0) point)) (< tmx tmy)))) (setq pointtim (list point (car kcminpoint) (cadr kcminpoint))) ) (defun c:GTEXT (/ luubatdiem spc tapchon tapdiem lstss text gtricaodo phannguyen p1 phapphan gtridien diemtam) (command "undo" "BE") (setq luubatdiem (getvar "osmode")) (setvar "osmode" 0) (setvar "CMDECHO" 0) ;;;;;;;;;;;;;;;;;;;;;;; (setq spc (vla-get-ModelSpace (vla-get-ActiveDocument(vlax-get-Acad-Object)))) (command "-layer" "n" "Caodo" "c" 4 "Caodo" "") (setq h (getreal "\nNhap cao chu:")) (prompt "\nchon tap diem Point Text") (setq tapchon (acet-ss-to-list (ssget (list (cons 0 "CIRCLE,TEXT"))))) (setq tapdiem (vl-remove-if-not '(lambda (x) (= (cdr (assoc 0 (entget x))) "CIRCLE")) tapchon)) (setq lstss (vl-remove-if-not '(lambda (x) (= (cdr (assoc 0 (entget x))) "TEXT")) tapchon)) (foreach ent tapdiem (setq p1 (cdr (assoc 10 (entget ent)))) (setq text (timtext p1 lstss)) (setq gtricaodo (vl-sort (list (cadr text) (caddr text)) '(lambda(x y) (< (car (car x)) (car (car y)))))) (setq phannguyen (cdr (car gtricaodo))) (setq phapphan (cdr (cadr gtricaodo))) (setq gtridien (strcat phannguyen "." phapphan)) (setq diemtam (car text)) (vla-put-Layer (vla-addtext spc gtridien (vlax-3d-point diemtam) h) "Caodo") ) (setvar "osmode" luubatdiem) (setvar "CMDECHO" 1) (command "undo" "End") )
  12. 1 điểm
    Cần 1 bản vẽ thực tế, với bản vẽ mẫu với 1 vài cao độ như này thì việc nối không khó. Các bạn đưa bản mẫu quá lý tưởng đến khi vào thực tế text nó chồng lên nhau lại kêu sao lisp chạy không đúng rồi lại yêu cầu người viết bổ sung này nọ, rất khó cho người viết.
  13. 1 điểm
    Block có màu thì mới có tác dụng nhé: (defun c:test (/ A LS OBJ) (setq obj (vlax-ename->vla-object (car (entsel)) ) color (vla-get-color obj)) (setq ls (vlax-safearray->list (vlax-variant-value (vla-Explode obj)))) (foreach n ls ; by block = 0 (if (= (vla-get-color n) 0) (vla-put-color n color)) ) )
  14. 1 điểm
    Chuột phải vào chữ "EXTERNAL REFERENCES" rồi click vào Close, còn Properties thì Ctrl+1(1 trên phím chữ, không phải bên NumLock)
  15. 1 điểm
    Các bạn có thể vào trang youtube này để download nhé, vị trí ở phần mô tả video
  16. 1 điểm
    Dùng để gióng vuông góc vào 1 đường thẳng giongline.lsp
  17. 1 điểm
  18. 1 điểm
  19. 1 điểm
    Lisp này không viết theo kiểu ssget được đâu (hoặc nếu được cũng xét điều kiện rất khổ). Cách đơn giản để không vơ đũa cả nắm là pick từng line/pline.
  20. 1 điểm
  21. 1 điểm
    Tôi bổ sung thêm 2 nguyên nhân : - do đã có các lisp tương tự trên diễn đàn này. - do người yêu cầu viết ko rõ ràng, cứ phải chạy theo "xin" số liệu, có t/hợp y/cầu thay đổi hoàn toàn so với trước đó. (cứ nhắc đi nhắc lại bài "Viết yêu cầu và trả lời như thế nào?" cũng chán)
  22. 1 điểm
    Chắc bạn không biết hiện nay đã có app dịch ngược vlx sang lsp? Cho nên nhiều khi chỉ bán được 1 bản rồi mất luôn code của mình. Cái app đó dù vô tình hay cố ý cũng đều nhằm mục đích diệt lispviet hết bạn ơi!
  23. 1 điểm
    Bạn Autotay nói không sai, còn nguyên nhân tại sao hồi trước khác bây giờ khác thì mỗi người chắc đều có cách lý giải khác nhau. - Đứng trên phương diện người biết lisp thì tôi cũng đồng ý với bạn là các lisper ngày trước chủ yếu là do đam mê code và muốn học hỏi để hoàn thiện bản thân nên có thể giúp đỡ vô vi lợi, còn bây giờ thì có lẽ họ đã đạt được mục đích đó nên họ không tiếp tục nữa chăng? Hoặc do cơm áo gạo tiền làm mất hết nhiệt tình của họ chăng? - Còn đứng trên phương diện người dùng thì tôi cũng hiểu là rất hiếm khi mình bỏ tiền ra mua app, ngay cả những app rẻ tiền trên Google play hay App store cũng vậy. Người dùng cad nói riêng lại càng ít muốn bỏ tiền mua lisp, cũng chẳng có gì là lạ cả. Nhiều khi tôi cũng nghĩ vui là thu nhập do bán lisp có lẽ không bằng với nghề lượm ve chai đâu bạn!! Còn nói về cái lisp của topic này, tôi nghĩ nếu dùng (command "PEDIT" ...) thì cũng chỉ vài dòng code, nhưng nếu không dùng command thì chắc phải vài trang code chứ không ít! Tôi không biết bác LuyTBui viết theo kiều nào chứ nếu viết kiểu sau mà giá "tô bún bò" (tính luôn tiền ship) thì quá rẻ, hề hề!!
  24. 1 điểm
    Bạn AutoTay.com cũng dễ thương và có đóng góp cho forum, ai lại nở vote (-) thế chứ.
  25. -1 điểm
    Dạo gần đây mình min các bản vẽ từ Cad ra máy in ( A3). Khi in trực tiếp từ file cad ra thì nét chữ rât đậm, nhiều ký tự nhỏ bị nhòe ko nhìn được. Nhưng khi chuyển sang PDF rồi in từ PDF ra máy in thì lại đúng nét ( Mình đã chỉnh nét rồi nhé, ) Các bác có ai đã từng bị ntn chưa ạ?
Bảng thành tích này được đặt thành Tp. Hồ Chí Minh /GMT +07:00


  • Newsletter

    Want to keep up to date with all our latest news and information?

    Sign Up
×