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

Tr.CongSon

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

  • Số lượng nội dung

    181

  • Đã tham gia

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

  • Ngày trúng

    4

Bài đăng được đăng bởi Tr.CongSon

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

    Lúc nãy mình gởi code rồi sao ko thấy hè

    Bạn apload rồi dung nhé

    Lệnh: SA

    (defun c:SA (/ gfile lstdwg n path scr)
    (grtext
    -1
    "CT Ch\U+1EA1y H\U+00E0ng Lo\U+1EA1t B\U+1EA3n V\U+1EBD...!!! @ Tr\U+1EA7n S\U+01A1n-Detail"
    )
    (setq gfile (getfiled
    "Ch\U+1ECDn FileDWG t\U+00F9y \U+00FD trong Folder :"
    ""
    "dwg"
    0
    )
    path (vl-filename-directory gfile)
    lstdwg (vl-directory-files path "*dwg")
    pathscr (strcat path "\\" "RunAll.scr")
    scr (open pathscr "w")
    )
    (foreach x lstdwg
    (write-line (strcat "OPEN " "\"" path "\\" x "\"" " QSAVE CLOSE ") scr)
    )
    (close scr)
    (command "script" pathscr)
    (princ)
    )
    • Vote tăng 1

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

    Comment hồi sang chừ mà không thấy chủ thớt hồi âm luôn .Buồn that !

    Đã code xong cho  anh rồi đây

    Anh xem thử đúng chưa nhé!

     

    (defun TS:Getboundary (ent / ll ur)
    (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
    (mapcar 'vlax-safearray->list (list ll ur))
    )
    ;;;---------------------
    (defun TS:sel (/ ent)
    (while
    (progn
    (setvar 'errno 0)
    (setq ent (entsel "\nCh\U+1ECDn Block \U+0111\U+1EC3 th\U+1ED1ng k\U+00EA : "))
    (cond
    ((= 7 (getvar 'errno)) (princ "\nCh\U+1ECDn l\U+1ED7i.Vui l\U+00F2ng l\U+1EA1i."))
    ((= 'ename (type (car ent)))
    (if (wcmatch (cdr (assoc 0 (entget (car ent))))
    "INSERT"
    )
    (progn (setq ent (car ent))
    nil
    )
    (princ "\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i Block.")
    )
    )
    )
    )
    )
    ent
    )
    ;;;---------------------
    (defun TS:eText (pt justify txt / Lst)
    (setq Lst (list (cons 0 "TEXT")
    (cons 8 "TAREA")
    (cons 7 "Arial")
    (cons 10 pt)
    (cons 40 31.5)
    (cons 41 1)
    (cons 71 0)
    (cons 1 txt)
    )
    )
    (cond ((= justify "C")
    (setq Lst (append Lst (list (cons 72 1) (cons 73 2) (cons 11 pt))))
    )
    ((= justify "L")
    (setq Lst (append Lst (list (cons 72 0) (cons 73 2) (cons 11 pt))))
    )
    )
    (entmakex lst)
    )
    ;;;---------------------
    (defun TS:Eline (p1 p2)
    (entmakex
    (list
    (cons 0 "LINE")
    (cons 8 "TAREA")
    (cons 10 p1)
    (cons 11 p2)
    )
    )
    )

    ;;;---------------------
    (defun TS:MakeBTK (point / p1 p2 p3 p4 p5 p6)
    (setq p1 (list (+ (car point) 68) (+ (cadr point) 30))
    p2 (list (+ (car point) 274) (+ (cadr point) 30))
    p3 (list (+ (car point) 424) (+ (cadr point) 30))
    p4 (list (+ (car point) 1545) (+ (cadr point) 30))
    p5 (list (car pt) (+ (cadr pt) 60))
    p6 (list (+ (car pt) 1305) (+ (cadr pt) 60))
    )
    (TS:Eline p5 p6)
    (mapcar 'TS:eText
    (list p1 p2 p3 p4)
    (list "C" "C" "L" "L")
    (list (nth 1 lsttxt) (nth 0 lsttxt) txt_PL item))
    )

    ;;;;;;;------------------;;;;;;;;;;
    (defun c:BTK (/ entblk i item ll lsttxt osm pt pt1 pt2 pt3 pt4 pt5 sstxt txt_pl ur)
    (setvar "Modemacro" "@ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ Detail SS")
    (setvar "cmdecho" 0)
    (command "Undo" "Be")
    (setq osm (getvar "osmode"))
    (setvar "osmode" 1)
    (setq pt (getpoint
    "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n B\U+1EA3ng Th\U+1ED1ng K\U+00EA : "
    )
    i 0
    )
    (while (setq entblk (TS:sel))
    (setq ll (car (TS:Getboundary entblk))
    ur (cadr (TS:Getboundary entblk))
    item (cdr (assoc 1
    (entget (ssname (ssget "W"
    ll
    ur
    (list (cons 0 "TEXT")
    (cons 8 "0")
    (cons 62 2)
    (cons 1 "@*")
    )
    )
    0
    )
    )
    )
    )
    sstxt (acet-ss-to-list
    (ssget "W"
    ll
    ur
    (list (cons 0 "TEXT")
    (cons 8 "0")
    (cons 62 2)
    (cons 1 "#*")
    )
    )
    )
    sstxt (vl-sort sstxt
    '(lambda (x1 x2)
    (< (cadr (assoc 10 (entget x1)))
    (cadr (assoc 10 (entget x2)))
    )
    )
    )
    lsttxt (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) sstxt)
    txt_PL (strcat "PL" (nth 3 lsttxt) "x" (nth 4 lsttxt) "x" (nth 2 lsttxt))
    )
    (TS:MakeBTK pt)
    (setq pt (list (car pt) (+ (cadr pt) 60)))
    (setq i (1+ i))
    )
    (setq pt1 (list (+ (car pt) 135) (cadr pt))
    pt2 (list (+ (car pt) 412) (cadr pt))
    pt3 (list (+ (car pt) 885) (cadr pt))
    pt4 (list (+ (car pt) 1095) (cadr pt))
    pt5 (list (+ (car pt) 1305) (cadr pt))
    )
    (TS:Eline pt1 (list (car pt1) (- (cadr pt1) (* i 60))))
    (setvar "osmode" 0)
    (command "_.copy" (entlast) "" "M" pt1 pt2 pt3 pt4 pt5 "")
    (setvar "osmode" osm)
    (command "Undo" "End")
    (setvar "cmdecho" 1)
    (princ)
    )
    • Vote tăng 1

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

    Chủ đề không khó nhưng hình như các cao thủ bận hết rồi :)

    Giờ thấp thủ như mình giúp bạn được ko ^^

    Mình có chút thắc mắc về các bước thực hiện lisp của bạn:

    1. Không chon điểm để chèn bang thong kê thì Lisp biết điểm nào để chèn BTK vào đây bạn :)
    2. Cái khung HCN to đó luôn là Pline hay sao ạ ?
    3. Cái khoảng trống ở giữa còn cái chi nữa hay chỉ có vậy thôi ^^
    4. Cái Item đó luôn là FLASHING hay còn cái tên nào khác??

    P/s: Lần sau post bài bạn nhớ đọc nội quy trước đã nhé !

    Thanks!

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

    Đã Code xong cho anh rồi đây :)

    Có chỗ nào cần khắc phục thì anh chị cho ý kiến nhé.hi

     


    (defun c:TBV (/ curfname curpath fname k_mau ll osm somax ssent strf strso ur x)
    (grtext
    -1
    "CT T\U+00E1ch nhanh b\U+1EA3n v\U+1EBD ...!!! @ Tr\U+1EA7n C\U+00F4ng S\U+01A1n-Detail"
    )
    (defun TS:Max_numb (/ fnamelst lstso)
    (if
    (setq fnamelst (vl-remove curfname (vl-directory-files curpath (strcat fname "*.dwg"))))
    (setq lstso (mapcar '(lambda (x / strf strso)
    (setq strf (strlen fname)
    strso (atoi (substr x (1+ strf) (- (strlen x) strf 4)))
    )
    )
    fnamelst
    )
    )
    (setq lstso (list 0))
    )
    (1+ (apply 'max lstso))
    )
    (defun _sel (/ ent)
    (while
    (progn
    (setvar 'errno 0)
    (setq ent (entsel "\nCh\U+1ECDn Pline or Block \U+0111\U+1EC3 t\U+00E1ch b\U+1EA3n v\U+1EBD : "))
    (cond
    ((= 7 (getvar 'errno)) (princ "\nMissed, try again."))
    ((= 'ename (type (car ent)))
    (if (wcmatch (cdr (assoc 0 (entget (car ent))))
    "LWPOLYLINE,INSERT"
    )
    (progn (setq ent (car ent))
    nil
    )
    (princ "\nInvalid object selected.")
    )
    )
    )
    )
    )
    ent
    )

    ;;;------------MAIN FUNCTION-------------
    (setvar "cmdecho" 0)
    (setq osm (getvar "OSMODE")
    curpath (getvar "DWGPREFIX")
    curfname (getvar "DWGNAME")
    fname (vl-filename-base curfname)
    somax 0
    )
    (setvar "osmode" 0)
    (while
    (setq k_mau (_sel))
    (progn
    (vla-getboundingbox (vlax-ename->vla-object k_mau) 'll 'ur)
    (setq ll (vlax-safearray->list ll)
    ur (vlax-safearray->list ur)
    )
    (command ".zoom" "o" k_mau "")
    (setq ssent (ssget "w" ll ur)
    somax (itoa (TS:Max_numb))
    )
    (command "_.wblock" (strcat curpath fname somax ".dwg") "" ll ssent "")
    (command "_.oops")
    )
    )
    (command ".zoom" "e")
    (setvar "osmode" osm)
    (setvar "cmdecho" 1)
    (princ)
    )
    • Vote tăng 1

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

    Mình chỉ làm ví dụ hình như thế, còn các polyline có thể nằm ở các layer khác nhau. Tên block cũng có thể thay đổi tùy theo bản vẽ. :) không biết yêu cầu hơi mở thế có làm được không :D

    Em làm được nhưng phải pick = tay ạ,chứ không quét chọn hàng loạt được ^^

    Nếu muốn chọn hàng loạt thì nên thay đổi polyline và block đó sang 1 layer  riêng thì dễ hơn ạ :)

    • Vote tăng 1

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

    A cho e hỏi: Có phải các Polyline1,2 là 1 layer riêng biệt là layer 3 block1 có tên là khung ko ạ.

    Nếu vậy thì Khi chạy lisp thì chỉ cần chọn vùng chứa các  Polyline1,2 và Block1 ni là được,chứ không cần phải pick chọn từng đối tượng 1 :)

    Tối ni em code thử xem sao :)

    • Vote tăng 1

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

    mọi người ơi, cho em hỏi với, em muốn STRETCH một đối tượng ra một khoảng mà em phải nhập bằng phép toán có mở đóng ngoặc thì em phải làm thế nào được ạ, em dùng lệnh STRETCH sau rồi dùng tiếp lênh CAL nhưng cũng chỉ sử dụng được khi không có dấu mở đóng ngoặc thôi (...). Mong các tiền bối chỉ giáo giúp em với, hay có lisp cad nào không ạ

     

    Sorry a Ha,do em không đọc kỹ ý của a^^

    Nhưng ý của chủ thớt như ri mà a phải nhập bằng phép toán có mở đóng ngoặc thì em phải làm thế nào được ạ, ^^

     

    Command: s STRETCH
    Select objects to stretch by crossing-window or crossing-polygon...
    Select objects: 1 found
    Select objects:
    Specify base point or [Displacement] <Displacement>:
    Specify second point or <use first point as displacement>: 'cal
    >>>> Expression: (30/3+20+10*2-40)
     
    Resuming STRETCH command.
     
    Specify second point or <use first point as displacement>: 10

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

    2 ví dụ:

    'CAL >> 30/3

    (/ 30 3)

    Nhập như a Doan Van Ha là nhập theo kiểu Autolisp rồi ạ ^^ Mà nhập vậy thì nó chạy báo lỗi như ri a ơi ^^

    Nếu chủ thớt muốn nhập nhiều phép tính thì chỉ cần thêm ( ở đầu và ) ở cuối phép tính là được ạ

    Command: cal
    >> Expression: (/ 30 3)
    Error:
    Wrong syntax of expression
     
    >> Expression: (30 / 3)
    10

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

    Các bác cho em hỏi chút về thuật toán.

    Em có 1 list

    Ngoài thuật toán sort ra, em muốn lấy ra danh sách nào mà có phần tử đầu tiên nhỏ nhất trong danh sách ấy được không ạ? (Ví dụ trên thì kết quả trả về (0 23) )

    Nếu dùng hàm apply 'min.....thì áp dụng được không ạ?

     

     Em nghĩ dùng Vl-sort nhanh hơn chứ.^^

     Nếu apply'min thì như vây đuợc ko ạ

    (setq l2 (apply 'min (mapcar 'car l1))

    lst (list l2 (cadr (assoc l2 l1))))

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

     

    1/ Code của bạn không có vấn đề gì. Nhưng bất tiện ở chỗ : khi tìm đường dẫn tới thư mục giả sử là A thì :

    a) Nếu trong A có các file *.lsp và các thư mục C, D thì nó không load các file trong A mà chỉ load các file trong C, D

    B) Nếu trong A chí có các file *.lsp thì nó mới load các file này :)

    2/ Bạn nói báo lỗi :

     
    Command: AUTOLOAD_TRANSON
    ; error: VLISP: internal: Document application(.VLX) not found
    Tôi cũng không hiểu sao có lỗi này vì bạn load có chọn lọc là các file *,lsp :wub: .
    3/ Chú ý đặc biệt : Các thư mục và file tuyệt đối không gõ dấu Vietnamese khi load các file ứng dụng của Autocad.

     

     

    Cảm ơn @pphung183

    1. Em thiếu trường hợp này ^^hi.Để em nghiên cứu Code thêm ^^.Cho em hỏi thêm tí: Có cách nào ,khi mình load lần đầu tiên ,nó sẽ lưu luôn đường dẫn zô cái biến lstpath nứ không a??
    2. Hì hục 1 ngày thứ 7 ,ruốt cuộc cũng tìm ra lỗi rồi anh ^^ Nguyên nhân do em dùng lisp này của chị ThuyLinh313: http://www.cadviet.com/forum/topic/66851-da-xong-tu-dong-bat-tat-che-do-go-tieng-viet-trong-cad/
    3. Không chỉ cho Autocad mà các phần mêm khác cũng nên làm như vậy ạ ^^

    P/s: Dạo này em gõ comment ,cái con trỏ chuột hay chuyển về đầu dòng và copy past 1 số thông tin vào bài gửi thì nó lại bị che mờ hoặc ẩn đi -->gây khó chịu cho người đọc lắm ạ.Hix.Các a Mod xem lại giúp.Thanks!

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

    Chào anh chị,

     Em có viết 1 đoạn lisp nhỏ để load các file  lisp trong 1 folder chỉ định truớc như sau:

     

    (defun C:AutoLoad_TranSon (/ dd lstfile lstpath path pathlsp)

    (vl-load-com)
    (setvar "Modemacro" "@ Tran Cong Son _ Detail SS")
    (setq lstpath (list "D:\\My Documents\\Desktop\\Scrip"
    "D:\\4.AutoLisp\\2.Tran Son_AutoLisp"
    );;;List cac Folder can Load
    )
    (foreach path lstpath
    (setq lstdir (vl-directory-files path "*" -1)
    lstdir (vl-remove-if '(lambda (x) (wcmatch x ".,..")) lstdir)
    pathlsp (list)
    )
    (if lstdir
    (setq pathlsp (append pathlsp (mapcar '(lambda (x) (strcat path "\\" x)) lstdir)))
    (setq pathlsp (cons path pathlsp))
    )
    (foreach dd pathlsp
    (setq lstfile (vl-directory-files dd "*.lsp")
    lstfile (vl-remove "Autoload File Lisp-Tran Son.LSP" lstfile))
    (mapcar '(lambda (x) (vl-load-all (strcat dd "\\" x))) lstfile)
    )
    )
    (princ)
    )
    (C:AutoLoad_TranSon)

     

    Hôm qua nó chạy bình thường nhưng hôm nay load nó hiện thông báo trên commmandline như thế này ạ

     
    Command: AUTOLOAD_TRANSON
    ; error: VLISP: internal: Document application(.VLX) not found

     

    Anh chị check giúp em COde có sai chỗ nào không với...

    Em cảm ơn,

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

    Sửa lại như a @ndtnv thì lisp chạy "mướt mờ" luôn.hehe^^ Like like!!

     Em  đọc trong Help thấy như vậy: dxf 5 (Handle) ,dxf 330 (Soft-pointer ID/ handle tone dictionary )

    Nhưng ko hiểu nó là cái gì ^^ và mục đích của cái này làm gì ạ.Em chỉ biết mỗi cái dxf -1 là entityname thôi.

    Theo như anh giải thích thì bây giờ khi entmake dim2 thì em chỉ cần loại bỏ 3 cái mã -1 ,5,330 ra khỏi list là được đúng ko ạ???

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

    Chào các anh chị,
    Em mới viết 1 đoạn Lisp để chia 1 dimension thành 2 dimension như sau:

    (defun C:dvd (/ dim1 dim2 dim_ent elist elist1 elist2 en_pt osm pt st_pt)
    (setvar "CMDECHO" 0)
    (command "Undo" "BE")
    (setq osm (getvar "osmode"))
    (setq dim_ent (car (entsel "\nSelect dimension:"))
    elist (entget dim_ent)
    st_pt (cdr (assoc 13 elist))
    en_pt (cdr (assoc 14 elist))
    )
    (setvar "osmode" 4)
    (setq pt (getpoint "\nPick point for new node location : "))
    (entmake elist)
    (setq dim1 (entlast)
    elist1 (entget dim1)
    elist1 (subst (cons 14 pt) (assoc 14 elist1) elist1)
    )
    (entmod elist1)
    (entmake elist)
    (setq dim2 (entlast)
    elist2 (entget dim2)
    elist2 (subst (cons 13 pt) (assoc 13 elist2) elist2)
    )
    (entmod elist2)
    (command "erase" dim_ent "")
    (setvar "OSMODE" osm)
    (command "Undo" "BE")
    (setvar "CMDECHO" 1)
    (princ)
    )

     
     Sau khi chạy Lisp thì nó vẫn chia thành 2 dimension nhưng nó lại chồng lên nhau,mặc dù trước đó em đã subst mã dxf 13 và 14 cho 2 dim khác nhau rồi ạ (tham khảo file)

    Anh chị có thể giải thích cho em hiểu thêm về vấn đề này với ạ

    em cảm ơn

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

    Thanks các anh chị nhiều !

    Lisp nào cũng có cái hay riêng của nó,do đang học nên cũng tò mó phá tí để học hỏi thêm ^^

    Anh Doan Van Ha :Code của anh thì em đã dùng và thấy khá hay ,code lại  dễ hiểu nên ổn rồi anh ( Like ^^)

    Anh  Tue_NV : Code a đã hết "nháy nháy" rồi ạ ^^  ( Like ^^)

    Anh snowman.hms : Code sau ni hay thiệt ^^ mỗi lần quét nó sẽ highlight luôn chứ không giống code trước ( Like ^^)

    Ở code đầu tiên của a snowman.hms  thì em chỉ cần sữa như vầy + với a anti lazy hướng dẫn là đúng mục đích của e rồi .Hi

    (if lst
    (progn
    (setq
    listpoint (mapcar
    '(lambda (x)
    (acet-ss-to-list
    (ssget "_C" (car x) (cadr x) '((0 . "CIRCLE") (62 . 1)))
    )
    )
    (reverse lst)
    )
    )
    )
    )

     

    Chúc mọi người buổi sang zui zẻ nhé!

    • Vote tăng 1

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

    Thuật toán & code có rồi, code của Doan Van Ha thêm 1 lệnh, code của snowman.hms chỉ cần thêm 1 biến phụ rồi đưa vào if là được.

    Phần chính & khó nhất đã xong, bạn phải tự nghiên cứu để làm phần còn lại,

    Nếu không thì chỉ có:

    Xin, xin nữa, xin mãi !!!!!

    Cảm ơn bạn đã góp ý !!

    Mình toàn học mót Lisp trên cadviet nên trình độ còn kém,những cái tự viết được thì mình đã làm,nhưng những cái khó quá mình mới nhờ anh em code giúp thôi

    Thật ra ,2 lisp trên cũng gần đúng ý mình,nên mình mót và chế lại theo đúng ý mình rồi

    Do đang thử code a Hạ thì mình bị như vậy mà mình xử lý không được nên mới đành post bài nhờ anh em chỉ bảo  thêm

    Đoạn xanh mong bạn giải thích rõ thêm tí được ko,do hàm grread mình chưa rõ lắm nên sửa mãi mà chưa được (mục đích của mình thì chỉ khi mình pick chon điểm để quét vùng nó mới nhảy dòng Princ ,chứ ko muốn nhảy liên tục như code của a snowman.hms )

    Hơi tham lam tí nên anh chị thông cảm.Hi

×