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

Luongquocsonxd

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

    17
  • Đã tham gia

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

  • Ngày trúng

    1

Cộng đồng

-13 (kém)

About Luongquocsonxd

  • Cấp bậc
    biết zoom
  1. Luongquocsonxd

    NẠP ĐẠN (.LSP) CHO STARTUP SUITE ĐỂ "BẮN"

    Để Load nhiều file Lisp cho chương trình Acad, để sau mỗi lần khởi động Acad thì file lisp sẽ tự động load. Cách hay làm thủ công là: nhập lệnh APPLOAD sau đó bấm cái nút contents... và đi tìm file lisp để Add vào thế là xong Hỏi: Có cách nào load 5 file lisp mà không cần dùng đến cách ở bên trên, ví dụ như là viết một hàm defun sau đó nhập lệnh thì tự động 5 file lisp kia "BAY" thẳng vào Contents... (CHÚ THÍCH: Contents... là cái biểu tượng hình cái cặp sau khi nhập lệnh APPLOAD)
  2. Luongquocsonxd

    LOAD NHIỀU FILE .CUI CÙNG MỘT LÚC

    Trong file Lisp này chỉ Load được có một file ISO-Vinx.cui Nếu muốn load thêm một file nữa, ví dụ là ISO-Vinx-01.cui thì đoạn code sẽ như thế nào? Tsk! (defun c:loadit (/ cui_database mnbar flag) (vl-load-com) (setq cui_database (list "ISO-VINX" "C:\\ISO-Vinx.cui" "ISO") flag nil) (vlax-for n (setq all_menus (vla-get-MenuGroups (vlax-get-Acad-Object))) (if (= (strcase (vla-get-name n)) (car cui_database)) (setq flag T)) ) (if (null flag) (progn (vla-load all_menus (cadr cui_database)) (setq MnBar (vla-get-MenuBar (vlax-get-Acad-Object))) (vla-InsertInMenuBar (setq mewPopUpMenu (vla-Item (vla-get-Menus (setq newMenuGroup (vla-Item (vla-get-MenuGroups (vlax-get-Acad-Object)) (car cui_database)))) (caddr cui_database))) (1- (vla-get-Count MnBar)) ) ) (princ "\n>>..MENU IS ALREADY LOADED..<<") ) (setq newToolBar (vla-item (vla-get-Toolbars newMenuGroup) 0)) (vla-put-Visible newToolBar :vlax-true) (setq ltb nil lpm nil) (vlax-for item newToolBar (setq ltb (cons (vla-get-name item) ltb))) (vlax-for item NewPopUpMenu (setq lpm (cons (list (vla-get-Index item) (vla-get-TagString item) (vla-get-Caption item) (vla-get-Macro item)) lpm)) ) (setq lpm (vl-sort lpm '(lambda(x y) (car x) (car y)))) (princ) )
  3. Nhờ anh em hỗ trợ. Cảm ơn! GHI TEXT NEW.dwg ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=600 (defun c:Pid(/ cen doc i h height lst msp ov pt row str stt tblobj vl width x y) ;Point ID out ;; By : Gia Bach, Copyrightゥ December 2009 ;; ;; Contact : gia_bach @ www.CadViet.com ;; (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0) (progn (princ "\nChon cac POINT de xuat ra Bang toa do :") (if (ssget '((0 . "POINT"))) (progn (vl-load-com) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) msp (vla-get-modelspace doc)) (vlax-for e (vla-get-ActiveSelectionSet doc) (setq cen (vlax-safearray->list (variant-value (vla-get-Coordinates e))) lst (cons (list (car cen)(cadr cen) )lst)) );vlax-for (setq lst (vl-sort lst '(lambda (x y) (or (< (car x) (car y));Check X (and (> (cadr x) (cadr y));Check Y (= (car x) (car y));Equal X ) ) ) )) (setq vl '("dimzin" "cmdecho") ; Sys Var list ov (mapcar 'getvar vl)) ; Get Old values (mapcar 'setvar vl '(0 0)) (or *h* (setq *h* 175)) (initget 6) (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :"))) (if h (setq *h* h) (setq h *h*) ) (setq str (last lst)) (if (> (car str)(cadr str) ) (setq str (car str)) (setq str (cadr str))) (setq width (* 2(TxtWidth (rtos str) h msp)) width1 (* 2 (TxtWidth "STT" h msp)) height (* 2 h)) (if (> h 3) (setq width (* (fix (/ width 10))10) width1 (* (fix (/ width1 10))10) height (* (fix (/ height 5))5))) (setq i 1 row 2 pt (getpoint "\nDiem dat Bang :") TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 height width)) (vla-put-vertcellmargin TblObj (/ h 4)) (vla-SetColumnWidth TblObj 0 width1) (mapcar '(lambda (x)(vla-setTextHeight TblObj x h)) (list acTitleRow acHeaderRow acDataRow) ) (mapcar '(lambda (x)(vla-setAlignment TblObj x 8)) (list acTitleRow acHeaderRow acDataRow)) (vla-setText TblObj 0 0 "Bang toa do") (vla-setText TblObj 1 0 "STT") (vla-setText TblObj 1 1 "X") (vla-setText TblObj 1 2 "Y") (foreach pt lst (setq stt (itoa i)) (vla-AddText msp stt (vlax-3d-point (polar pt (/ pi 4) (/ h 4))) h) (vla-setText TblObj row 0 stt) (vla-setText TblObj row 1 (rtos (car pt))) (vla-setText TblObj row 2 (rtos (cadr pt))) (setq row (1+ row) i (1+ i)) ) (vlax-release-object TblObj) (mapcar 'setvar vl ov) ;reset Sys Vars (princ) ) ) ) (alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)") ) ) (defun TxtWidth (val h msp / txt minp maxp) (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h)) (vla-getBoundingBox txt 'minp 'maxp ) (vla-Erase txt) (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp))) )
  4. Luongquocsonxd

    NHỜ ANH EM SỬA GIÚP ĐOẠN LISP

    Mình cảm ơn bạn thanhduan2407 nhiều nhé! Chúc bạn sức khỏe, công việc tốt!
  5. Luongquocsonxd

    NHỜ ANH EM SỬA GIÚP ĐOẠN LISP

    ;; Thường thi khi chọn đối tượng thì đối tượng đó hiển thị những đường nét đứt (giống như nét Hidden) ;; Mình gửi đoạn lisp nội dung là thay thế Text ứng với một Text trước đó có sẵn ;; Sau khi mình nhập lệnh và chọn text "nguồn" thì Text nguồn đó không hiển thị dạng nét đứt để mô tả là đối tượng Text nguồn đã được chọn mà nó vẫn bình thường ;; Nhiều khi lick chọn đối tượng Text nguồn nhưng không biết là đã chọn được nó chưa ;; nhờ anh em giúp làm sao khi chọn Text nguồn thì nó hiển thị dạng nét đứt để dễ nhận biết là nó đã được chọn. ;; Thank you anh em! (defun C:TC1 (/ con rep ch_text so_text text_val text_run) (setvar "Cmdecho" 0) (setq so_text NIL text_val NIL ch_text NIL so_text(entsel "\nChon Text goc <Noi dung mau>: ")) (if so_text (progn (setq so_text(entget(car so_text))) (if(or(= (cdr(assoc 0 so_text)) "TEXT");Kiem tra du lieu Text (= (cdr(assoc 0 so_text)) "MTEXT") ) (setq text_val(cdr(assoc 1 so_text)) ) );if (if(> (strlen text_val) 0) (progn (prompt "\nChon Texts muon sua noi dung theo Text goc: ") (setq ch_text(ssget '((0 . "*TEXT"))) ) ) (princ "\nKhong chon duoc Texts can sua !") );if (if(and ch_text text_val) (progn (setq rep (sslength ch_text) con 0) (while (> rep con) (setq text_run(entget(ssname ch_text con)) ch_val(assoc 1 text_run)) (setq text_run(subst (cons 1 text_val) ch_val text_run)) (entmod text_run) (princ ".") (setq con(+ con 1)) );while (princ "\n")(princ rep)(princ " Texts da duoc thay doi !") );progn );if );progn );if (princ) );
  6. Luongquocsonxd

    LỆNH LINE THEO NHÓM POINTS

    Mình cảm ơn Doan Nguyen Van và bạn alisp rất nhiều. Chúc các bạn sức khỏe và công việc tốt! Thân chào!
  7. Luongquocsonxd

    LỆNH LINE THEO NHÓM POINTS

    Bạn Doan Nguyen Van có thể gửi mình đoạn lisp.Thank you bạn! Mail: luongquocsonxd@gmail.com
  8. Luongquocsonxd

    LỆNH LINE THEO NHÓM POINTS

    Bạn có thể gửi Lisp cho mình qua Emai luongquocsonxd@gmail.com Thanks Bạn
  9. Luongquocsonxd

    LỆNH LINE THEO NHÓM POINTS

    Tuyệt vời quá! Thanks bạn
  10. Bước 1: Chọn cái ống Bước 2: Vào menu Tool --> Draw Order --> Bring to Front Bước 3: Dùng lệnh REGEN XONG!
  11. Luongquocsonxd

    LỆNH LINE THEO NHÓM POINTS

    Chào bạn. Đó là 4 đường riêng biệt không giao cắt, không đối xứng gì hết.
  12. Luongquocsonxd

    LỆNH LINE THEO NHÓM POINTS

    Vậy là chọn hai lần, mình nhờ đoạn Lisp. Cảm ơn bạn!
  13. Luongquocsonxd

    LỆNH LINE THEO NHÓM POINTS

×