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

HoangSon614

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

    252
  • Đã tham gia

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

  • Ngày trúng

    1

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


  1.  

    Yêu cầu khá là "mơ hồ", vui lòng gửi file Cad minh hoạ.

    Gửi lại List Fix  lỗi tên block tiếng Việt  : 

    (defun c:BlkQty (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i
    		 ins j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y)
    ;;  By : Gia Bach, gia_bach @  www.CadViet.com             ;;
    (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)))  )
    
    (defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
      (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE") )  
      (foreach itm (vlax-for itm objTblStyDic
    		 (setq tabLst (append tabLst (list itm))))
        (if (not
    	  (vl-catch-all-error-p
    	    (setq name (vl-catch-all-apply 'vla-get-Name (list itm)))))
          (setq nameLst (append nameLst (list name)))  )  )
      (if (not (vl-position tbl_name nameLst))
        (vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
      (setq objTblSty (vla-item objTblStyDic tbl_name)
    	TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
      (mapcar '(lambda (x)(vla-settextstyle objTblSty x TxtSty))
    	      (list acTitleRow acHeaderRow acDataRow) )
      (vla-setvariable *adoc "CTableStyle" tbl_name) )
      
    (defun GetObjectID (obj)
      (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
        (vlax-invoke-method
          (vla-get-Utility *adoc)
          'GetObjectIdString obj :vlax-false )
        (vla-get-Objectid obj)))  
    ;main
      (if (setq ss (ssget (list (cons 0 "INSERT"))))
        (progn
          (vl-load-com)
          (setq i -1 len0 8)
          (while (setq ent (ssname ss (setq i (1+ i))))
    	(setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))
    	(if (> (setq blk_len (strlen blk_name)) len0)
    	  (setq str blk_name len0 blk_len) )	
    	(if (not (assoc blk_name lst_blk))
    	  (setq lst_blk (cons (cons blk_name 1) lst_blk))
    	  (setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk))))
    			       (assoc blk_name lst_blk) lst_blk)))	    )
          (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y)) ) ))
          (setq cur_var (mapcar 'getvar '("DYNMODE" "DYNPROMPT")))
          (mapcar 'setvar '("DYNMODE" "DYNPROMPT") '(1 1))
          (initget "Yes No")
          (setq ins (getkword "\nChen ki hieu Block [Yes/No ] <yes> : ") )
          (or ins (setq ins "Yes"))
          (mapcar 'setvar '("DYNMODE" "DYNPROMPT") cur_var)      
          (or *h* (setq *h* (* (getvar "dimtxt")(getvar "dimscale"))))
          (initget 6)
          (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))      
          (if h (setq *h* h) (setq h *h*) )
          (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object))
    	    msp (vla-get-modelspace *adoc)
    	    blks (vla-get-blocks *adoc))      
          (setq width1 (* 2 (TxtWidth "STT" h msp))
    	    width (* 2 (TxtWidth "So luong" h msp))
    	    height (* 2 h))
          (if str
    	(setq width2 (* 1.5 (TxtWidth (strcase str) h msp)))
    	(setq width2 width))
          (if (> h 3)
    	(setq width (* (fix (/ width 10))10)
    	      width1 (* (fix (/ width1 10))10)
    	      width2 (* (fix (/ width2 10))10)
    	      height (* (fix (/ height 5))5)))
          (GetOrCreateTableStyle "CadViet")
          (setq pt (getpoint "\nDiem dat Bang :")
    	    TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width))
          (vla-put-regeneratetablesuppressed TblObj :vlax-true)
          (vla-SetColumnWidth TblObj 0 width1)
          (vla-SetColumnWidth TblObj 1 width2)
          (vla-put-vertcellmargin TblObj (* 0.75 h))
          (vla-put-horzcellmargin TblObj (* 0.75 h))
          (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
    	      (list acTitleRow acHeaderRow acDataRow) )
          (mapcar '(lambda (x)(vla-setAlignment TblObj x 2))
    	      (list acTitleRow acHeaderRow acDataRow))      
          (vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 3)) )))
          (vla-setText TblObj 0 0 "Bang thong ke")
          (setq j -1 header_lsp (list "STT" "Ten" "Don vi" "So luong" "Ky hieu")) 
          (repeat (length header_lsp)
    	(vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
          (setq row 2 i 1)    
          (foreach pt lst_blk
    	(setq blk_name (car pt) j -1 )
    	(mapcar '(lambda (x)(vla-setText TblObj row (setq j (1+ j)) x))
    		(list i blk_name "cai" (cdr pt)))
    	(if (= ins "Yes")
    	  (vlax-for blk blks
    	    (if (= (vla-get-Name blk) blk_name)
    	      (vla-SetBlockTableRecordId TblObj row 4 (GetObjectID blk) :vlax-true))) )
    	(vla-SetCellAlignment TblObj row 1 7)
    	(vla-SetCellAlignment TblObj row 3 9)
    	(setq row (1+ row) i (1+ i))	)
          (vla-put-regeneratetablesuppressed TblObj :vlax-false)
          (vlax-release-object TblObj) )  )
      (princ))
    

    Cảm ơn gia_bach đã quan tâm

    Ý mình khi chọm điểm đặt bảng, font trong bảng thống kê là tiếng việt có dấu (style, font là Vni-helve)

    Rất mong sự giúp đỡ của gia_bach.


  2.  

    Chính xác. (do VL không hỗ trợ tốt Unicode)

     

    @pinggun :

    tìm dòng : (setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))

    và thay thế bằng : (setq blk_name (cdr (assoc 2 (entget ent))))

     

     

     

     

    Lisp rất tuyệt vời, tìm mãi mới được cái lisp đúng với nhu cầu công việc

    Xin lỗi gia_bach, nhờ gia_bach bớt chút thời gian sửa giúp mình font có dấu được không? (font vni-helve nhé)

    Cảm ơn gia_bach nhiều


  3. Nhà mình ơi!

    Sao cad 2004 của mình không viết được chữ " Ư " nhỉ. Mình vào một bản vẽ có sẵn của cad 2004 , định Tạo một đoạn văn bản mới nhưng không viết được chữ Ư trong khi nhấn edit để sửa đoạn văn bản có sẵn thì lại viết được chữ đó. Ai chỉ cách khắc phục giùm với.

    Bạn xem lại font bạn sử dụng là gì? hoặc xem lai bộ gõ (telex hay vni)


  4. khó chịu quá, sao mình chỉnh theo bạn nói thì thoát ra rồi vào lại kiểm tra thì đơn vị vẫn là mm( mình chọn mm cho 2 ô luôn đúng ko ) nhưng khi vẽ thì nhập 100mm chẳng hạn thì nó ko phải là đơn vị mm mà là rất lớn , là inch thì phải, Vậy là sao.

    Rất lớn là sao hả bạn, bạn kiểm tra lại thử xem có đúng là kích thước mm không nhé?

    (Nếu được bạn save lại Cad 2007 up lên mình xem thử sao)


  5. Mặc Định Đơn Vị Kích Thước cho Bản Vẽ???Thóa Ra là lại như Cũ

    Các bạn có thể giúp mình cách mặc định đơn vị trong autocad2010 ko, làm sao vậy, mình vào chỗ print á, chọn mm thì nó chỉ được lúc đó thôi. Thoát ra làm file khác thì nó lại đổi về inch, làm sao mặc định luôn là mm ???!!! giúp tui( mình mới học nên chưa rành các bạn thông cảm giúp mình)

    Bạn vào Tool -> options -> User prefecences -> Insertion Scale -> chuyển về MM -> Apply -> OK.

    Chúc bạn làm được


  6. Mình đang dùng cad 2007 và 2008, gần đây cad bị nhiễm vi rút hay sao mà nó không thực hiện lệnh plot. Muốn in phải đặt page setup trước rồi dùng lệnh preview plot rồi plot. làm thế này mất công mà chỉ in được từng bản vẽ một. Bạn nào biết cách khắc phục lỗi này làm ơn chỉ giúp với. Mình có cài lại cad rồi mà vẫn bị thế.

    Bạn tải cái này về, copy vào support của Cad, dùng lệnh AP load lisp vào thử xem sao

    • Vote tăng 1

  7. các bac chỉ em cách vẽ line ma có kèm theo text bên trong line

    vd như nhé:

    ----------water----------water----------water----------

    ++++++++++water++++++++++water++++++++++water++++++++++

    Cái này tạo bằng Mkltype trong bộ Express của Cad, bạn search trong diễn đàn có hướng dẫn cách tạo đó bạn. Bạn nghiên cứu rồi làm. Chúc bạn thành công

×