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

CuongXD7

Thành viên
  • Số lượng nội dung

    26
  • Đã tham gia

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

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


  1. Em cũng dùng 1 DIM cho bản vẽ thôi anh
    Bước 1: Em vẽ các đối tượng bên Model tỉ lệ 1:1
    Bước 2: Tạo 1 DIM 1:1 rồi Dim kích thước đối tượng đó
    Bước 3: Đối tượng nào cần trình bày TL nào thì mình chỉnh biến DimScale theo TL đó 
    Bước 4:  Qua Layout em tạo MV nữa là xong
    Cách của em làm như vậy ^^, em cũng đang tìm hiểu và học hỏi thêm ... (Em đang dùng AutoCad2007)


  2. 17 phút trước, NTHAHT đã nói:

    (defun c:SDD  (/ ss)
      (and (setq ss (ssget '((0 . "DIMENSION"))))
           (mapcar '(lambda (x) (vla-put-ScaleFactor (vlax-ename->vla-object x) 20))
                   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (princ))

    Cảm ơn bác, file chạy đúng với mong muốn rồi, em cứ tưởng code đơn giản ai dè nó cũng phức tạp quá, cảm ơn bác rất nhiều


  3. Vào lúc 2/6/2023 tại 16:54, duy782006 đã nói:

    Mình chọn giải pháp cứ vẽ bình thường. Xong bản vẽ trước khi xuất làm cái lisp gán layer cho các loại đối tượng. Ví dụ dim thì như sau:

    
    (defun c:cld ()
    
    (setq chondim (ssget "X" (list (cons 0 "DIMENSION")) ))
    
    (cond
    ((/= chondim nil) (command "change"  chondim "" "p" "la" "kthuoc-9" "") )
    )
    
    (princ))

    Các loại đối tượng khác cũng vậy thích thì thêm vào như hatch, text, ...

    Chào anh Duy, 
    Em nhờ anh chỉ giúp em Lisp này xíu
     Quét chọn các đối tượng Dim rồi vào Properties gán cho biến  Dim Scale Oveall: 20
    (Defun C: SDD()
      (Setq lis (Ssget '((0 . "Dimension"))))
      (setq Lis (setvar  "DIMSCALE"  20 ))
    (princ))
    Nhờ anh xem và chỉ giúp em với


  4. Vào lúc 13/11/2016 tại 11:09, Doan Van Ha đã nói:

    Thấy nhiều bạn than phiền các lisp vẽ Đường Đồng Mức (ĐĐM) thường chạy chậm, thậm chí đôi khi treo máy, nên tôi làm cái này phục vụ cộng đồng.

    Lisp có một phần nguồn từ Internet, tôi hiệu chỉnh và bổ sung để tăng tốc độ xử lý. Một phần khác tự viết.

    Code mở nên mọi người tha hồ vọc. Lệnh: DDM.

    Test với bản vẽ 22629 points ở máy tôi chỉ mất 60 giây (với các thông số mặc định trong lisp).

    Chức năng: vẽ các tam giác TIN, vẽ ĐĐM, tô màu theo cao độ cho ĐĐM.

    Đối tượng: tập các point, hoặc tập các text, hoặc tập các block_att cao độ.

    File Cad để test:

    http://www.mediafire.com/file/c3ey62x9rb35bu6/Draw_Contour_HA.dwg

    File Lisp:

    http://www.mediafire.com/file/90u0sgqmukkuft7/Draw_Contour_HA.lsp

    File Image:

    http://www.mediafire.com/view/ydyhy3csv9pg4yd/Draw_Contour_HA.png

     

    Còn vài điều chưa hài lòng lắm, sẽ sửa sau. Hy vọng được đem đến nguồn vui cho mọi người!

    Cảm ơn anh


  5. Vào lúc 20/4/2009 tại 05:52, Tue_NV đã nói:

    nhưng với cad 2004, 2005 thì bó tay vì cái lệnh "-h" của cad này ko ra những lựa chọn như lệnh "-hatch" của 2007. Bạn có thể nói rõ cái ý này được không? . Tue_NV đang sử dụng CAD2004

    Đoạn Code sau tạo boundary cho đa giác "hở". Hy vọng chạy đúng ý bạn:

     

    
    (defun c:boh()
    (vl-load-com)
    (prompt "\n Chon doi tuong tao thanh Boundary : ")
    (setq ssg (ssget))
    (setq po (getpoint "\n Pick 1 diem trong da tuyen :"))
    (setq frome (entlast))
    (Command "copy" ssg "" po "@")
    (setq toe (entlast))
    (setq cur frome ; khoi tao
    ssgg (ssadd)
    )
    (while (not (eq cur toe)) ;; 
    (setq
    cur (entnext cur)
    ssgg (ssadd cur ssgg)
    )
    )
    
    (setq n (sslength ssg)
    i 0)
    (while ((setq curve (ssname ssg i))
    (setq dd (vlax-curve-getStartPoint curve))
    (setq dc (vlax-curve-getEndPoint curve))
    (command "extend" ssg "" "e" "e" dd dc "")
    (setq i (1+ i))
    )
    
    (setq frome (entlast))
    (Command "boundary" po "")
    (setq toe (entlast))
    (setq cur frome ; khoi tao
    ss (ssadd)
    )
    (while (not (eq cur toe)) ;; 
    (setq
    cur (entnext cur)
    ss (ssadd cur ss)
    )
    )
    (Command "erase" ssgg "")
    (sssetfirst ss ss) 
    
    (princ)
    )
    
     

     

    PS : Nói tạo tạo boundary cho đa giác "hở" thì không đúng. Vì tạo boundary trên một đa giác kín trên cơ sở extend các đường hở để tạo thành các đường kín.

    Hy vọng code chạy đúng ý bạn.

    Chúc thành công nhé :cheers:

    File không chạy được anh ơi

    • Vote giảm 1

  6. Vào lúc 8/2/2018 tại 15:15, CuongXD7 đã nói:

    Gửi anh Duy, gửi các bác,
     -   Ở các Lisp của anh Duy chỉ mới là canh lề thôi chứ chưa chỉnh thuộc tính Justify của Text bao gồm (Left, Right, Center, Middle Left, Midle Right, Middle center ...)
     -   Nhhờ các anh chỉnh lại dùm em với.
     

    Nhờ các anh giúp em với, em tìm trên diễn đàn rồi nhưng chưa tìm được  bài viết lisp nào nói về cái jutify của TEXT cả.


  7. Vào lúc 9/2/2018 tại 09:13, Doan Van Ha đã nói:

     

    
    (defun C:CA (/ dt p1 p2 sl s2 i )
     (command "undo" "be")
     (setq osm (getvar "osmode"))
     (setq dt (ssget)
           p1 (getpoint "\nDiem goc: ")
           p2 (getpoint p1 "\nDiem den: ")
           sl (getint "\nSo lan: ")
           s2 (/ (distance p1 p2) sl)
           i 1)
     (setvar "osmode" 0)
     (repeat sl
      (command ".copy" dt "" p1 (polar p1 (angle p1 p2) (* i s2)))
      (setq i (1+ i)))
     (command "undo" "e")
     (setvar "osmode" 1023)
     (princ))
    
    

    Cám ơn anh  nhé, đơn giản như vậy mà em mò mấy tiếng chưa được ^^

     


  8. Vào lúc 19/9/2011 tại 22:07, Doan Van Ha đã nói:

    Đây chắc đúng y/c của bạn.

     

    
    ;Doan Van Ha
    (defun C:CA (/ dt dsdt dt1 dt2 p1 p2 sl x)
    (command "undo" "be")
    (setq osm (getvar "osmode"))
    (princ "\nChon cac doi tuong can Copy-Array...")
    (setq dsdt (acet-ss-to-list (setq dt (ssget)))
           	p1 (getpoint "\nDiem goc: ")
           	p2 (getpoint p1 "\nDiem den: ")
           	sl (getint "\nSo lan: ")
           	x 1)
    (foreach n dsdt
     (if (or (= "TEXT" (cdr (assoc 0 (entget n)))) (= "MTEXT" (cdr (assoc 0 (entget n)))))
      (setq dt1 (ssdel n dt) dt2 n)))
    (setvar "osmode" 0)
    (repeat sl
     (command ".copy" dt1 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
     (command ".copy" dt2 "" p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
     (entmod (subst (cons 1 (itoa (+ (atoi (cdr (assoc 1 (entget dt2)))) x))) (assoc 1 (entget (entlast))) (entget (entlast))))
     (entupd (entlast))
     (setq x (1+ x)))
    (command "undo" "e")
    (setvar "osmode" osm)
    (princ))
    
     

     

    Nhờ các bác tối ưu dùm em code này với, em là binh nhì nên còn non kém.
    ;; free lisp from cadviet.com
    ;;; Downloaded from https://www.cadviet.com/forum/topic/54624-yêu-cầu-lisp-kết-hợp-lệnh-array-và-copy/
    (defun C:CA (/ dt p1 p2 sl s2 i )
    (command "undo" "be")
    (setq osm (getvar "osmode"))
    (setq dt (ssget)
            p1     (getpoint "\nDiem goc: ")
            p2    (getpoint p1 "\nDiem den: ")
            sl     (getint "\nSo lan: ")
        s2     (/ (distance p1 p2) sl)
        i 1
            )
    (setvar "osmode" 0)
    (repeat sl
    (command ".copy" dt "" p1 (polar p1 (angle p1 p2) s2 ))
    (Setq s2     (/ (distance p1 p2) sl))
    (setq i (+ 1 i))
    (setq s2 (* i s2))

    );----------------------------------DONG HAM REPEAT
    (command "undo" "e")
    (setvar "osmode" 1023)
    (princ))
     

    • Vote giảm 1

  9. Vào lúc 20/12/2014 tại 10:58, quochuyksxd đã nói:

    Gửi bạn

    Lệnh CLG=căn giữa; CLN=canh lề ngang; CLT: canh trái; CLP: canh phải

    http://www.cadviet.com/upfiles/4/100618_canhletext.lsp

    Gửi anh Duy, gửi các bác,
     -   Ở các Lisp của anh Duy chỉ mới là canh lề thôi chứ chưa chỉnh thuộc tính Justify của Text bao gồm (Left, Right, Center, Middle Left, Midle Right, Middle center ...)
     -   Nhhờ các anh chỉnh lại dùm em với.
     


  10. 25 phút trước, quocmanh04tt đã nói:

    Của bạn đây:

    (defun c:cdt  (/ els ent poi)
      ((lambda (i / str)
         (while
           (and (setq ent (car (nentsel "\nChon DIMTEXT: ")))
                (eq (cdr (assoc 0 (setq els (entget ent)))) "MTEXT")
                (setq poi (getpoint "\nPick diem dat Mtext: " (trans (cdr (assoc 10 els)) 0 1))))
            (setq str (strcat (itoa (setq i (1+ i))) "-" (cdr (assoc 1 els)))
                  els (subst (cons 1 str) (assoc 1 els) els))
            (entmake (subst (cons 10 (trans poi 1 0)) (assoc 10 els) els))))
        0)
      (princ))

    Hay là cái này:

     

    (defun c:cdt  (/ dim els ent poi)
      ((lambda (i / str)
         (while
           (and (setq dim (entsel "\nChon DIMTEXT: "))
                (setq ent (car (nentselp (cadr dim))))
                (eq (cdr (assoc 0 (setq els (entget ent)))) "MTEXT")
                (setq poi (getpoint "\nPick diem dat Mtext: " (trans (cdr (assoc 10 els)) 0 1))))
            (setq str (strcat (itoa (setq i (1+ i))) "-" (cdr (assoc 1 els))))
            (entmod (subst (cons 1 str) (assoc 1 (entget (car dim))) (entget (car dim))))
            (entmake (subst (cons 10 (trans poi 1 0)) (assoc 10 els) els))))
        0)
      (princ))

    Cả 2 cái đều ok cả,  đúng ý em rồi. ^^
    Cảm ơn anh nhé.


  11. Vào lúc 2/2/2018 tại 10:44, Nguyen Hoanh đã nói:

    Bạn làm theo cách này không cần lisp:

    1. Copy các dim mà bạn cần riêng ra một chỗ

    2. Dùng lệnh explode để phá dim thành text

    3. Dùng lệnh TCOUNT để đánh số thứ tự các text bạn vừa phá ra, bạn đến khi lệnh TCOUNT hỏi Overite, Prefix, Suffix, thì bạn chọn Prefix là được.

    Dạ, emcảm ơn anh Hoành, 
    - Tại em muốn tận dụng LISP để cho bớt thao tác đi một xíu
    - HIện tại em có sưu tầm một đoạn code của các anh trên diễn đàn nhưng không nhớ rõ của ai
    - Nhờ các anh hiệu chỉnh lại LISP dùm em với.
    - Em muốn thêm tiền tố số thứ tự tăng dần mỗi khi click dimension vào trước MTEXT để kiểm soát (tránh sai xót)
     

    (Defun c:cdt  (/ ent poi)
      (while (and (setq ent (car (nentsel "\nChon DIMTEXT: ")))
                  (eq (cdr (assoc 0 (entget ent))) "MTEXT")
                  (Setq poi (getpoint "\nPick diem dat Mtext: " (cdr (assoc 10 (entget ent))))))
        (entmake (subst (cons 10 poi) (assoc 10 (entget ent)) (entget ent))))
      (princ))
     

    Nhờ các anh giúp dùm em với. 


  12. Vào lúc 26/12/2007 tại 08:58, ssg đã nói:

    Tự tay mình lập một chương trình Lisp có gì khác so với nhờ ai đó làm? Chưa cần xét kết quả, điểm khác nhau rất cơ bản là bạn sẽ có được cái cảm giác rất là khoái chí (không thể diễn tả) khi chạy thử chương trình.

    Ssg lập topic này không ngoài mục đích tạo điều kiện cho các bạn tự mình tìm hiểu và khám phá cái cảm giác "khoái chí không thể diễn tả" nói trên.

    Với tinh thần "Share is Receive", ssg cũng mong các bạn đã thành thạo Lisp quan tâm giúp đỡ các bạn mới để cộng đồng Lisp của CadViet ngày càng đông vui và tạo được nhiều chương trình hữu ích.

    Để bắt đầu, ssg post lại một bài viết cũ, nhưng có lẽ vẫn còn mới đối với một số bạn. Hy vọng sẽ giúp được chút gì đó cho các bạn mới tiếp cận với Lisp:

     

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

     

    Download, giải nén rồi đọc file *.doc

    Hic hic có ai giúp em với link die mất rồi.
    Em đang trang thủ dịp nghỉ tết để mò về LISP mà giờ ko download được nữa.


  13. Nhờ anh viết dùm em lisp với nội dung như ở dưới được không ạ.

     Click vào đối tượng dim => dim doi thanh mau vang+đánh stt vào trước dim  và xuất ra TEXT

    (VD: em đang có dim ghi kích thước 2000 => click chuột dim chuyển thành 1-2000 (màu vàng) và xuất giá trị này ra text

    Mong được các anh giúp đỡ


  14. Chào cac anh,
    Nhờ anh viết dùm em lisp với nội dung như ở dưới được không ạ.

     Click vào đối tượng dim => dim doi thanh mau vang+đánh stt vào trước dim  và xuất ra TEXT

    (VD: em đang có dim ghi kích thước 2000 => click chuột dim chuyển thành 1-2000 (màu vàng) và xuất giá trị này ra text 

    Mong được cac anh  giúp đỡ


  15. Tiện đây nhờ các anh cho em hỏi xíu ?
    Nếu miền cần tạo polyline không được khép kín mà bị hở ra ví dụ như phòng chức năng có ô cửa đi thì lisp có làm được không ạ.
    Cái này lúc trước em có thấy trên diễn đàn có đề cập rồi nhưng em tìm không ra bài viết, mong các anh trợ giúp.

×