Viết lisp theo yêu cầu [phần 2]

Tháng 4 26, 2010

Hix không biết viết bài ở đâu đành xoá.

Chào 18011985,

Rất tiếc vì bạn đã xóa mất bài, định dành thời gian xem lại mà không được. Về yêu cầu của bạn nên post trong chủ đề Hỏi về lisp sẽ thích hợp hơn, nhưng đã lỡ post ở đây cũng không sao, không nhất thiết phải xóa như vậy.

Cám ơn bạn đã tham gia diễn đàn.

Tháng 4 26, 2010

Mình đã cài Cad 2008 và sử dụng được rồi, chạy rất tốt nhưng mình muốn bạn giúp mình tý nữa, cụ thể là:
1. Tăng độ rộng hàng lên 2 lần

2. Mặc định font chữ là Vni-hel

3. Cột thứ 2 mình muốn text nằm bên trái (không phải giữa)

Với 3 yêu cầu trên mình phải sửa như thế nào, nhờ bạn giúp mình. Cảm ơn bạn nhiều

Update theo yêu cầu :

1. độ rộng hàng : phụ thuộc vào ch/dài tên block, độ rộng hàng sẽ thay đổi để fix với tên block

2. Mặc định font chữ là Vni-hel : vì sẽ có t/hợp hệ thống không có font Vni, nên Lisp chỉ lấy TextStyle hiện hành làm mặc định.

Lisp sẽ tạo ra TableStyle mới có tên là CadViet và chọn TextStyle hiện hành làm font chữ mặc định.

3. Cột thứ 2 mình muốn text nằm bên trái : OK

bổ sung : cho phép user nhập chiều cao Text.

Code :

(defun c:BlkQty (/ blk_id blk_name ent h height i lst_blk msp pt row ss str tblobj width width1 width2 x y)
 ;;  By : Gia Bach, gia_bach @  www.CadViet.com             ;;
 (if (setq ss (ssget (list (cons 0 "INSERT"))))
   (progn
     (vl-load-com)
     (setq i -1)
     (while (setq ent (ssname ss (setq i (1+ i))))
(setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))
(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)) ) ))      
     (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 *acad (vlax-get-acad-object)
    *adoc (vla-get-ActiveDocument *acad)
    msp (vla-get-modelspace *adoc))
     (SetTblSty (GetOrCreateTableStyle "CadViet"))
     (setq str (MaxLenLst lst_blk)
    width (* 1.5 (TxtWidth (strcase str) h msp))
    width1 (* 2 (TxtWidth "STT" h msp))
    width2 (* 2 (TxtWidth "Don vi" h msp))
    height (* 2 h))
     (if (> h 3)
(setq width (* (fix (/ width 10))10)
      width1 (* (fix (/ width1 10))10)
      width2 (* (fix (/ width2 10))10)
      height (* (fix (/ height 5))5)))
     (setq pt (getpoint "\nDiem dat Bang :")
    TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 4 height width2))
     (vla-put-regeneratetablesuppressed TblObj :vlax-true)
     (vla-SetColumnWidth TblObj 0 width1)
     (vla-SetColumnWidth TblObj 1 width)
     (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))      
     (vla-MergeCells TblObj 0 0 0 3)
     (vla-setText TblObj 0 0 "Bang thong ke")
     (mapcar '(lambda (x y)(vla-setText TblObj 1 x y))
      (list 0 1 2 3)
      (list "STT" "Ten" "Don vi" "So luong"))      
     (setq row 2 i 1)    
     (foreach pt lst_blk
(setq blk_name (car pt)
      blk_ID (vla-get-objectID (vla-item (vla-get-blocks *adoc) blk_name)) )
(mapcar '(lambda (x y)(vla-setText TblObj row x y))
      (list 0 1 2 3)
      (list (itoa i) (car pt) "cai" (itoa (cdr pt))))
(vla-SetCellAlignment TblObj row 1 7)
(setq row (1+ row) i (1+ i))	)
     (vla-put-regeneratetablesuppressed TblObj :vlax-false)
     (vlax-release-object TblObj) )  )
 (princ))

(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 MaxLenLst (lst2d / len len0 str)
 (setq len0 10)
 (foreach lst lst2d
   (if (> (setq len (strlen (car lst))) len0)
(setq str (car lst) len0 len) ))
 (if str str "1111111111"))

(defun GetOrCreateTableStyle (tbl_name / namelst objtblstydic objtblstyle tablst)
 (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 objTblStyle (vla-item objTblStyDic tbl_name))
 (vla-setvariable *adoc "CTableStyle" tbl_name)
 objTblStyle
 )

(defun SetTblSty (objTblSty / TxtSty)
 (setq TxtSty (variant-value (vla-getvariable *adoc "textstyle")))
 (vla-settextstyle objTblSty acTitleRow  TxtSty)
 (vla-settextstyle objTblSty acHeaderRow TxtSty)
 (vla-settextstyle objTblSty acDataRow   TxtSty))

Tháng 4 26, 2010

"Được voi đòi Hai Bà Trưng" luôn

gia_bach cho luôn cột Ký hiệu chèn Block vào như hình luôn đi

Cảm ơn!

(Được 02 bà rồi không biết đòi thêm cái gì nữa đây? :undecided: )

Tháng 4 26, 2010

"Được voi đòi Hai Bà Trưng" luôn
gia_bach cho luôn cột Ký hiệu chèn Block vào như hình luôn đi

Cảm ơn!

(Được 02 bà rồi không biết đòi thêm cái gì nữa đây? :undecided: )

À, còn ở cột số lượng nếu <10 thì thêm số 0 vào trước ví dụ: 02

về Sort column như thế nào?

- Sắp xếp theo thứ tự AB cột Tên?

- hoặc sắp xếp theo Thứ tự giảm dần của cột số lượng?

- Hay sắp xếp tùy vào việc chọn đối tượng trên màn hình?

Tháng 4 26, 2010

thanks!

Tháng 4 27, 2010

mình đã ghi thêm 1 số thông tin vào file CAD mới này!TUE_NV xem giúp dùm mình nhé!
Thanks bạn!

P/S:mặc dù mình nhờ bạn và bác GIA BACH nhưng theo cá nhân của mình thì mình nghĩ công việc này mà dùng LISP chắc ko khả thi quá!nhưng mình vẫn hy vọng!nếu việc này không khả thi thì chắc mình sẽ chuyển sang câu hỏi khác và nhờ bạn giúp đỡ quá!

đó là đếm xem trong cái phần hatch đó có bao nhiêu lô đất (bao gồm cả nhà và sân) nằm trọn vẹn trong phần hatch (nói theo chuyên môn là bị giải tỏa trắng).

http://www.cadviet.com/upfiles/2/1_9.dwg

Thanks bạn đã quan tâm đến vấn đề của mình!

Chúc TUE_NV sức khỏe!

Mình nghĩ cad thuần tuý kg giúp đc vđ này đâu. Vđ này muốn làm đc phải có lệnh tìm đg bao hữu hiệu hơn lệnh hiện nay do cad cung cấp. Khi tìm đc hai đg bao (của đg hiện trạng và đg qui hoạch) mới tìm đc phần giao của chúng. Bạn nên tìm giải pháp khác.

Tháng 4 27, 2010

Mình nghĩ cad thuần tuý kg giúp đc vđ này đâu. Vđ này muốn làm đc phải có lệnh tìm đg bao hữu hiệu hơn lệnh hiện nay do cad cung cấp. Khi tìm đc hai đg bao (của đg hiện trạng và đg qui hoạch) mới tìm đc phần giao của chúng. Bạn nên tìm giải pháp khác.

mình nghĩ chắc là vậy quá!thanks bạn!

Tháng 4 27, 2010

Chào 18011985,
Rất tiếc vì bạn đã xóa mất bài, định dành thời gian xem lại mà không được. Về yêu cầu của bạn nên post trong chủ đề Hỏi về lisp sẽ thích hợp hơn, nhưng đã lỡ post ở đây cũng không sao, không nhất thiết phải xóa như vậy.

Cám ơn bạn đã tham gia diễn đàn.

Cảm ơn bạn đã quan tâm, mình có ý tưởng như sau: "Nội suy địa chất từ mặt cắt dọc cho mặt cắt ngang không cùng tỷ lệ"

Mình đã viết những lisp bị lỗi, mình đã thử kiểm tra từng phần, đến phần đổi tỷ lệ thì bị lỗi về giá trị giữa số và chữ. Chưa tìm ra cách giải quyết nên đưa lên mong các bạn góp ý. Sau đây là lisp của mình.

(defun c:a1 (/ tyleMCD tyleMCN tyleMCD0 tyleMCN0 Test gp n diem1 diem2 i X1 X2 Y1 Y2 Y3 XX 
YY D1 D2 P1 P2 Tenlop)
(setq tyleMCD0 100)
(setq tyleMCN0 100)
(setq tyleMCD tyleMCD0)
(setq tyleMCN tyleMCN0)
;;;--------------------- Phần lặp lại lựa chọn giữa tỉ lệ đứng MCD và tỉ lệ đứng MCN chỉ kết thúc khi nhập enter------
(while (and
(/= tyleMCD "")
(progn
(initget "tyleMCD tyleMCN")
(setq tyleMCD (getreal (strcat "\nMCD<1/"(rtos tyleMCD0 2 0)">/MCN(1/"(rtos tyleMCN 2 0)"): ")))
(if (or (= tyleMCD "MCD") (= tyleMCD "mcd") (= tyleMCD "tyleMCD") (= tyleMCD "tylemcd")
(= tyleMCD "MCN") (= tyleMCD "mcn") (= tyleMCD "tyleMCN") (= tyleMCD "tylemcn"))
(setq Test 1)
(setq tyleMCD0 tyleMCD)
); End of if (progn) (and)
); End progn (and)
); End progn
(if (or (= tyleMCD "MCD") (= tyleMCD "mcd") (= tyleMCD "tyleMCD") (= tyleMCD "tylemcd"))
(progn
(setq tyleMCD (getreal (strcat "\nMCD(1/"(rtos tyleMCD0 2 0)"): ")))
(setq tyleMCD0 tyleMCD)
); End progn (if)
); End if
(if (or (= tyleMCD "MCN") (= tyleMCD "mcn") (= tyleMCD "tyleMCN") (= tyleMCD "tylemcn"))
(progn
(setq tyleMCN (getreal (strcat "\nMCN(1/"(rtos tyleMCN0 2 0)"): ")))
(setq tyleMCN0 tyleMCN)
); End progn (if)
); End if
); End while
:::::::-----------------------------------------Số lớp địa chất, vị trí trên MCD, vị trí MCN---------------------
(setq n (getreal "\nSè líp: "))
(setq diem2 (getpoint "\n§iÓm thuéc ®êng M§TN cña MCD: "))
(setq diem1 (getpoint "\n§iÓm thuéc ®êng M§TN cña MCN: "))
(setq gp (ssget))
(setq X1 (car diem1) Y1 (cadr diem1))
(setq X2 (car diem2) Y2 (cadr diem2))
(setq i 1)
;;;----------------------------------------------Tiến hành đo và bắt đầu nội suy------------------------------
(while (<= i n)
(progn
(setq diema (getpoint (strcat "\n§¸y líp thø "(rtos i 2 0)": ")))
(setq Y3 (cadr diema))
(setq YY (- Y3 Y2))
(setq D1 (* YY (/ tyleMCD 1000)))
(setq D2 (* D1 (/ 1000 tyleMCN)))
(command "Copy" gp "" diem1 (list (car diem1) (- (cadr diem1) D2)) "")
(setq P1 (car diem1) P2 (+ (cadr diem1) (/ D2 2)))
(setq Tenlop (getstring "\n Líp:"))
(command "Text" "j" "mc" (List P1 P2) "1.5" "0" Tenlop )
(command "Circle" (List P1 P2) "2" )
)
(setq i (+ i 1))
(setq diem1 (list (car diem1) (+ (cadr diem1) D2)))
(setq Y2 Y3)
)
); End defun C:

PS: Check hộ mình nhé!

Tháng 4 27, 2010

E có 1 cái lisp kiếm đc của bọn nước ngoài,lisp dùng để thực hiện các phép toán cộng trừ nhân chia, e thấy rất hay nhưng khổ nỗi lại bị bản quyền, mã hóa file lisp và nếu ko mua thì sẽ bị lỗi font chữ và sẽ bị tính sai kết quả, ai có thể viết lại lisp này hộ e không?

http://www.cadviet.com/upfiles/2/sd_2704allcalculator.rar

Tên lệnh là : SD_2704

Tháng 4 28, 2010

E có 1 cái lisp kiếm đc của bọn nước ngoài,lisp dùng để thực hiện các phép toán cộng trừ nhân chia, e thấy rất hay nhưng khổ nỗi lại bị bản quyền, mã hóa file lisp và nếu ko mua thì sẽ bị lỗi font chữ và sẽ bị tính sai kết quả, ai có thể viết lại lisp này hộ e không?
http://www.cadviet.com/upfiles/2/sd_2704allcalculator.rar

Tên lệnh là : SD_2704

LISP phép toán cộng trừ nhân chia và trung bình cộng : free lisp from CadViet.

kết quả ghi ra màn hình CAD : http://www.cadviet.com/forum/index.php?sho...ost&p=65044

kết quả ghi vào 1 text có sẵn : http://www.cadviet.com/forum/index.php?sho...ost&p=65338

Tháng 4 28, 2010

Bạn chạy thử LISP này :
Update : http://www.cadviet.com/forum/index.php?sho...ost&p=93700

Chào bạn gia_bach! Mình là thành viên mới xin được ra mắt và mong được gia_bach và mong được mọi người giúp đỡ

Mình đang thiết kế điện công trình, mình đang cần lisp thống kê vật tư điện, may quá mình seach và tìm thấy lisp của bạn rất đúng với ý của mình

Nhưng mình có một yêu cầu nhỏ, mong được bạn giúp

1. Mình muốn thêm 1 cột nữa vào bảng thống kê (cột ký hiệu thiết bị) nằm tại vị trí cột thứ 3 (vậy là bảng thống kê có tổng cộng 5 cột)

2. Cột số lượng nếu <10 thì thêm số 0 vào trước (VD: 02, 03...)

Rất mong được bạn giúp. Cảm ơn bạn

Tháng 4 28, 2010

Chào bạn gia_bach! Mình là thành viên mới xin được ra mắt và mong được gia_bach và mong được mọi người giúp đỡ
Mình đang thiết kế điện công trình, mình đang cần lisp thống kê vật tư điện, may quá mình seach và tìm thấy lisp của bạn rất đúng với ý của mình

Nhưng mình có một yêu cầu nhỏ, mong được bạn giúp

1. Mình muốn thêm 1 cột nữa vào bảng thống kê (cột ký hiệu thiết bị) nằm tại vị trí cột thứ 3 (vậy là bảng thống kê có tổng cộng 5 cột)

2. Cột số lượng nếu

Rất mong được bạn giúp. Cảm ơn bạn

Mạn phép anh giaBach để Tue_NV giúp bạn thuthuypt77 một tay

Yêu cầu thứ 1 của bạn :

Bạn tìm dòng này trong code :

(setq pt (getpoint "\nDiem dat Bang :")

TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 4 height width2))

-->> thay thành dòng này :

(setq pt (getpoint "\nDiem dat Bang :")

TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width2))

Và bạn tìm dòng này :

(mapcar '(lambda (x y)(vla-setText TblObj 1 x y))

(list 0 1 2 3)

(list "STT" "Ten" "Don vi" "So luong"))

-->> thay thành dòng này :

(mapcar '(lambda (x y)(vla-setText TblObj 1 x y))

(list 0 1 2 3 4 )

(list "STT" "Ten" "Don vi" "So luong" "Ky hieu"))

Yêu cầu thứ 2 của bạn :

Bạn tìm dòng này trong code :

(mapcar '(lambda (x y)(vla-setText TblObj row x y))

(list 0 1 2 3)

(list (itoa i) (car pt) "cai" (itoa (cdr pt))))

-->> thay thành dòng này :

(mapcar '(lambda (x y)(vla-setText TblObj row x y))

(list 0 1 2 3)

(list (if (

Hy vọng bạn thành công :cheers:

Tháng 4 28, 2010

Mạn phép anh giaBach để Tue_NV giúp bạn thuthuypt77 một tay

Yêu cầu thứ 1 của bạn :

Bạn tìm dòng này trong code :

(setq pt (getpoint "\nDiem dat Bang :")

TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 4 height width2))

-->> thay thành dòng này :

(setq pt (getpoint "\nDiem dat Bang :")

TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width2))

Và bạn tìm dòng này :

(mapcar '(lambda (x y)(vla-setText TblObj 1 x y))

(list 0 1 2 3)

(list "STT" "Ten" "Don vi" "So luong"))

-->> thay thành dòng này :

(mapcar '(lambda (x y)(vla-setText TblObj 1 x y))

(list 0 1 2 3 4 )

(list "STT" "Ten" "Don vi" "So luong" "Ky hieu"))

Yêu cầu thứ 2 của bạn :

Bạn tìm dòng này trong code :

(mapcar '(lambda (x y)(vla-setText TblObj row x y))

(list 0 1 2 3)

(list (itoa i) (car pt) "cai" (itoa (cdr pt))))

-->> thay thành dòng này :

(mapcar '(lambda (x y)(vla-setText TblObj row x y))

(list 0 1 2 3)

(list (if (< i 10) (strcat "0" (itoa i)) (itoa i)) (car pt) "cai" (itoa (cdr pt))))

Hy vọng bạn thành công :cheers:

Cảm ơn Tue_NV đã quan tâm.

bạn có thể xem lại giúp mình được không?

Ý thứ 1: Ý mình là thêm 1 cột tại vị trí thứ 3 (khi thống kê kèm theo hình vẽ minh hoạ) -> ý này mình nói không rõ mong Tue_NV bỏ qua

Ý thứ 2: Tue_NV xem lại giúp khi số lượng <10 không có số 0 nằm trước (mình đã thử nhiều lần)

Một lần nữa làm phiền bạn. Cảm ơn bạn nhiều lắm

Tháng 4 28, 2010

Bạn thử code Lisp này nhé :

(defun c:dstt(/ ss delta ob chuoi chdau chcuoi)
(vl-load-com)
;; copyright by Tue_NV
(setq ss (ssget "X" (list(cons 0 "*TEXT") (cons 1 "T10A030*"))) i -1)
(setq delta (getint "\n so tang giam :"))
(while (setq ent (ssname ss (setq i (1+ i))))
(setq ob (vlax-ename->vla-object ent))
(setq chuoi (vlax-get ob 'textstring))
(setq chdau "T10A030")
(setq chcuoi (atoi (substr chuoi (1+ (strlen chdau)) (strlen chuoi))))
  (if (and (>= (+ chcuoi delta) 0) (<= (+ chcuoi delta) 9))
(vlax-put ob 'textstring (strcat chdau "0" (itoa (+ chcuoi delta))))
  )
  (if (> (+ chcuoi delta) 9)
(vlax-put ob 'textstring (strcat chdau (itoa (+ chcuoi delta))))
  )
)
(princ)
)

load vào báo sucessful nhưng khi nhập lệnh dstt thi báo Unknown command "DSTT". Press F1 for help. Trong lệnh trên nếu thay T10A030 bằng một text khác bất kỳ có thể thay đổi kiểu TABCDEF, trong đó EF là kiểu ký tự số, TABCD có thể là chữ hoặc số thì phải làm sao. Mình chỉ cần 2 con số cuối của text thay đổi thôi còn các ký tự trước đó không quan tâm là gì. Cảm ơn Tue_NV

Tháng 4 28, 2010

Xin chào mọi người.Mình có 1 yêu cầu nhỏ.Mọi người giúp đỡ.Ai có lisp tính diện tích phần hatch rồi ghi ra file text ( có thể ghi bất kỳ chỗ nào mình kích chuột hoặc là chọn text sẵn có cũng được).Trên diễn đàn có file lisp này rồi nhưng link không down được.Ai có hoặc làm được thì up lên giúp mình nhé.Cảm ơn rất nhiều.

Tháng 4 28, 2010

LISP phép toán cộng trừ nhân chia và trung bình cộng : free lisp from CadViet.

kết quả ghi ra màn hình CAD : http://www.cadviet.com/forum/index.php?sho...ost&p=65044

kết quả ghi vào 1 text có sẵn : http://www.cadviet.com/forum/index.php?sho...ost&p=65338

Nếu b dùng lisp của m post lên, b sẽ thấy swj khác biệt, m muốn đc như lisp kia, có nghĩa là hiện ra hộp thoại ( + - x :=), như thế sẽ tiệ hơn rất nhiều, khi mình nhập xong phép tính và chọn dấu (=) thì 1 hộp thoại khác hiện ra, cho phép b chọn số chữ số sau dấu phẩy, layer, màu sắc của kết quả, và cũng cho phép b ghi kết quả theo 2 cách, 1 là update vào text đã có sẵn, 2 là tạo mới và chèn vào màn hình, mong b có thể giúp m :cheers:

Tháng 4 29, 2010

Cảm ơn Tue_NV đã quan tâm.
bạn có thể xem lại giúp mình được không?

Ý thứ 1: Ý mình là thêm 1 cột tại vị trí thứ 3 (khi thống kê kèm theo hình vẽ minh hoạ) -> ý này mình nói không rõ mong Tue_NV bỏ qua

Ý thứ 2: Tue_NV xem lại giúp khi số lượng

Một lần nữa làm phiền bạn. Cảm ơn bạn nhiều lắm

Chào bạn thuthuypt77

Bạn thử Lisp mà Tue_NV đã chỉnh lại thử nhé :

http://www.cadviet.com/upfiles/2/blkqty.lsp

@damvinhduy : Lisp Tue_NV đã chỉnh lại cho bạn. Bạn chạy lại thử nhé:

(defun c:dstt(/ ss delta ob chuoi chdau chcuoi)
(vl-load-com)
;; copyright by Tue_NV
(setq ss (ssget (list(cons 0 "*TEXT") (cons 1 "*##"))) i -1)
(setq delta (getint "\n so tang giam :"))
(while (setq ent (ssname ss (setq i (1+ i))))
(setq ob (vlax-ename->vla-object ent))
(setq chuoi (vlax-get ob 'textstring))
;(setq chdau "T10A030")
(setq chdau (substr chuoi 1 (- (strlen chuoi) 2)))
(setq chcuoi (atoi (substr chuoi (1+ (strlen chdau)) (strlen chuoi))))
  (if (and (>= (+ chcuoi delta) 0) (	(vlax-put ob 'textstring (strcat chdau "0" (itoa (+ chcuoi delta))))
  )
  (if (> (+ chcuoi delta) 9)
(vlax-put ob 'textstring (strcat chdau (itoa (+ chcuoi delta))))
  )
)
(princ)
)

Tháng 4 29, 2010

Chào bạn thuthuypt77
Bạn thử Lisp mà Tue_NV đã chỉnh lại thử nhé :

http://www.cadviet.com/upfiles/2/blkqty.lsp

Tue_NV xem lại giúp

1. khi thống kê kèm theo hình vẽ minh hoạ: chưa thấy thể hiện được

2. số lượng <10 số 0 nằm trước (VD: 02, 03...): hình như Tue_NV nhằm (số 0 lại nằm cột STT)

Phiền bạn giúp mình tiếp nhé. Cảm ơn bạn

Tháng 4 29, 2010

Tue_NV xem lại giúp
1. khi thống kê kèm theo hình vẽ minh hoạ: chưa thấy thể hiện được

2. số lượng <10 số 0 nằm trước (VD: 02, 03...): hình như Tue_NV nhằm (số 0 lại nằm cột STT)

Phiền bạn giúp mình tiếp nhé. Cảm ơn bạn

Lại thêm một người "Được voi đòi 02 Bà Trưng"

Vụ này hình như các cao thủ: một là muốn "giữ bí mật" hai là "ngoài khả năng"

Thôi đành chịu khó mà ngồi Insert Block vào Table đi bạn

Và nhớ Edit Text <10 luôn cho nó trọn vẹn

Tháng 4 29, 2010

Tue_NV xem lại giúp
1. khi thống kê kèm theo hình vẽ minh hoạ: chưa thấy thể hiện được

2. số lượng

Phiền bạn giúp mình tiếp nhé. Cảm ơn bạn

Sorry. Tue_NV nhầm ở cột STT -> Chỉnh lại cho bạn đây :

http://www.cadviet.com/upfiles/2/blkqty1.lsp

Còn hình vẽ minh hoạ thì mình còn .. nghiên cứu tiếp :cheers:

Tháng 4 29, 2010

Còn hình vẽ minh hoạ thì mình còn .. nghiên cứu tiếp :cheers:

Vụ chèn hình này đúng là "khó ăn" đây

Ngay cả ACA cũng không giải quyết rốt ráo vụ này mà vẫn phải chèn một cách thủ công với Graphic Properties

Tháng 4 29, 2010

Sorry. Tue_NV nhầm ở cột STT -> Chỉnh lại cho bạn đây :
http://www.cadviet.com/upfiles/2/blkqty1.lsp

Còn hình vẽ minh hoạ thì mình còn .. nghiên cứu tiếp :cheers:

Cảm ơn Tue_NV, chạy tốt rồi

Còn hình vẽ minh hoạ thì mình còn .. nghiên cứu tiếp: Chờ tin bạn

Tháng 4 29, 2010

Vụ chèn hình này đúng là "khó ăn" đây
Ngay cả ACA cũng không giải quyết rốt ráo vụ này mà vẫn phải chèn một cách thủ công với Graphic Properties

Vụ chèn hình là “chuyện nhỏ” cũng không phải "giữ bí mật" nhưng vì muốn giải quyết rốt ráo nên chậm Update cho anh em.

Nhưng nay thấy "AKA buông súng" nên Post lên anh em sài thử!

- cột số lượng nếu <10 thì thêm số 0 vào trước ví dụ: 02

thọat nghe có vẽ có lý, nhưng t/hợp cột số lượng có giá trị hàng trăm (hàng ngàn) thì các số khác cũng phải biểu thị cùng format.

VD : 001 002 010 … với hàng ngàn còn rối mắt hơn.

Để giải quyết t/hợp này chỉ cần căn lề phải các số là hợp lý.

- Sort column :

mặc định LISP sort cột Tên theo mẫu tự ABC tên của BLOCK

việc sort theo cột số lượng là t/hợp ít khi dùng nên bỏ qua (đôi khi vẫn sử dụng) :cheers:

các t/hợp khác cần phải viết thêm hộp thoại cho USER chọn lựa →

Sau 02 bà rồi sẽ là cái này :

Bổ sung tùy chọn : nhập ký hiệu Block

Code :

(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
     (setq Utility
       (cond
  (Utility)
         ((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 ]  : ") )
     (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")
  (vla-SetBlockTableRecordId TblObj row 4 (GetObjectID (vla-item blks blk_name)) :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))

Chỉnh sửa Tháng 9 17, 2010 theo gia_bach

Tháng 4 29, 2010

Vụ chèn hình là “chuyện nhỏ” cũng không phải "giữ bí mật" nhưng vì muốn giải quyết rốt ráo nên chậm Update cho anh em.

Nhưng nay thấy "AKA buông súng" nên Post lên anh em sài thử!

...........

Sau 02 bà rồi sẽ là cái này :

Bổ sung tùy chọn : nhập ký hiệu Block

Code :

(defun c:BlkQty (/ blk_id blk_len blk_name cur_var ent h height i ins 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")))
 (vla-settextstyle objTblSty acTitleRow  TxtSty)
 (vla-settextstyle objTblSty acHeaderRow TxtSty)
 (vla-settextstyle objTblSty acDataRow   TxtSty)
 (vla-setvariable *adoc "CTableStyle" tbl_name) )
;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) (      (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 ] : ") )
     (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  :")))      
     (if h (setq *h* h) (setq h *h*) )
     (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object))
    msp (vla-get-modelspace *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))      
     (vla-MergeCells TblObj 0 0 0 3)
     (vla-setText TblObj 0 0 "Bang thong ke")
     (mapcar '(lambda (x y)(vla-setText TblObj 1 x y))
      (list 0 1 2 3 4)
      (list "STT" "Ten" "Don vi" "So luong" "Ky hieu"))      
     (setq row 2 i 1)    
     (foreach pt lst_blk
(setq blk_name (car pt) )
(mapcar '(lambda (x y)(vla-setText TblObj row x y))
      (list 0 1 2 3)
      (list i blk_name "cai" (cdr pt)))
(if (= ins "Yes")
  (vla-SetBlockTableRecordId TblObj row 4 (vla-get-objectID (vla-item (vla-get-blocks *adoc) blk_name))
: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))

Code quá tuyệt, gãi đúng ngay chổ ngứa :cheers: . Tick thanks không chưa đã, phải nói lời cảm ơn mới được.

Tue_NV chân thành cảm ơn anh gia bach thật nhiều

Tháng 4 29, 2010

Vụ chèn hình là “chuyện nhỏ” cũng không phải "giữ bí mật" nhưng vì muốn giải quyết rốt ráo nên chậm Update cho anh em.
Nhưng nay thấy "AKA buông súng" nên Post lên anh em sài thử!

- cột số lượng nếu <10 thì thêm số 0 vào trước ví dụ: 02

thọat nghe có vẽ có lý, nhưng t/hợp cột số lượng có giá trị hàng trăm (hàng ngàn) thì các số khác cũng phải biểu thị cùng format.

VD : 001 002 010 … với hàng ngàn còn rối mắt hơn.

Để giải quyết t/hợp này chỉ cần căn lề phải các số là hợp lý.

- Sort column :

mặc định LISP sort cột Tên theo mẫu tự ABC tên của BLOCK

việc sort theo cột số lượng là t/hợp ít khi dùng nên bỏ qua (đôi khi vẫn sử dụng) :cry:

các t/hợp khác cần phải viết thêm hộp thoại cho USER chọn lựa →

Thật tiếc là chưa Test được Sản phẩm mới của gia_bach

(Chạy trên nền Win Vista64 không hiểu sao nó lại lố bịch)

Rất vui vì đây là lần đầu tiên hiếm hoi bác gia_bach tỏ ra tự tin với cái chuyện "rốt ráo"

Nhưng chắc chắn rằng:

29/04 vẫn chưa phải là ngày giải phóng

Và cho dù "ACA buông súng" tạo hòa bình thì vẫn chưa thể "hòa hợp dân tộc" được.

:cheers:

P/s: Hy vọng chiều nay được thưởng thức sản phẩm của gia_bach trên nền win32

Cảm ơn gia_bach rất nhiều!

Autolisp trở nên huyền ảo hơn nhờ những người như vậy!

Đọc lại mới thấy gia_bach dùng từ "ACA buông súng" thật đa nghĩa :cheers: nhưng từ từ sẽ bàn sau

Về cột số lượng, giải thích của gia_bach không thuyết phục

Do ý nghĩ Format đồng nhất nên mới có sự rối mắt khi số lên đến hàng nghìn

Đối với số: người ta chỉ cần thêm 0 vào các số từ 1-9 mà thôi theo quy tắc của văn bản

(Chuyện cũng tương tự như ghi ngày tháng với tháng 1,2 thì cần phải thêm 0. Với tháng 3 thì không cần vì không có tháng 13)

Như vậy, ở cột số lượng phải thỏa mãn 02 điều kiện:

- Nếu từ 1-9 phải thêm 0 vào đắng trước

- Khi sắp xếp phải sắp xếp theo số

Về việc Sort: Đúng là đòi hỏi quá đáng so với Autolisp nên gia_bach cứ chủ động áp đặt luật chơi

:cry:

Đăng nhập

Viết lisp theo yêu cầu [phần 2]

Các bài được khuyến nghị

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.549

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

trinhvqh 226

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

trinhvqh 226

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

truongthanh 7

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

TRUNGNGAMY 91

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

truongthanh 7

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

18011985 62

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

mCuongs 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.549

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thuthuypt77 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thuthuypt77 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

damvinhduy 3

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

queen2k8 4

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

mCuongs 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thuthuypt77 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

trinhvqh 226

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912