Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

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


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#1121 trinhvqh

trinhvqh

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 408 Bài viết
Điểm đánh giá: 222 (khá)

Đã gửi 25 April 2010 - 09:48 AM

TUE_NV ơi!
Mong tin bạn!


Tin đã về rồi
Nhưng bạn hãy bình tĩnh
Từ từ mô tả cho các cao thủ lisp rõ yêu cầu của bạn

(Về phía Tôi lại thấy yêu cầu của bạn rõ ràng mà tại sao gia_bach và Tue_NV cứ làm bộ vậy nhỉ?)
  • 1

#1122 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 25 April 2010 - 09:55 AM

Bạn chạy thử LISP này :

(defun c:BlkQty (/ blk_name ent i lst_blk pt row ss tblobj x y)
(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)) ) )
pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable
(vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vlax-3d-point pt) (+ (length lst_blk) 2) 4 375 2000))
(vla-SetColumnWidth TblObj 0 1000)
(vla-SetColumnWidth TblObj 1 3000)
(vla-put-vertcellmargin TblObj 50)
(mapcar '(lambda (x y)(vla-setTextHeight TblObj x y))
(list acTitleRow acHeaderRow acDataRow)
(list 250 250 175))
(mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
(list acTitleRow acHeaderRow acDataRow))
(vla-MergeCells TblObj 0 0 0 2)
(vla-setText TblObj 0 0 "Bang thong ke")
(vla-setText TblObj 1 0 "STT")
(vla-setText TblObj 1 1 "Ten")
(vla-setText TblObj 1 2 "Don vi")
(vla-setText TblObj 1 3 "So luong")
(setq row 2 i 1)
(foreach pt lst_blk
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (car pt))
(vla-setText TblObj row 2 "cai")
(vla-setText TblObj row 3 (itoa (cdr pt)))
(setq row (1+ row) i (1+ i)) ) )
(vlax-release-object TblObj) )
(princ))

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
  • 0
-~-~-~-~-~-~-~-~-~-~-~-~-~-~
Hôm qua là sự học hỏi nhận được sau 1 ngày
Ngày mai là sự bí ẩn mà chúng ta sẽ khám phá


------------------------------------------
http://www.tailieukythuat.com

#1123 truongthanh

truongthanh

    biết lệnh text

  • Members
  • PipPipPipPip
  • 275 Bài viết
Điểm đánh giá: 7 (bình thường)

Đã gửi 25 April 2010 - 11:19 AM

Thanks bạn đã quan tâm đến vấn đề của mình!
Chúc TUE_NV sức khỏe!
  • 0

#1124 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 25 April 2010 - 10:05 PM

Hix không biết viết bài ở đâu đành xoá.
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#1125 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 26 April 2010 - 09:51 AM

Bạn chạy thử LISP này :

(defun c:BlkQty (/ blk_name ent i lst_blk pt row ss tblobj x y)
(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)) ) )
pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable
(vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vlax-3d-point pt) (+ (length lst_blk) 2) 4 375 2000))
(vla-SetColumnWidth TblObj 0 1000)
(vla-SetColumnWidth TblObj 1 3000)
(vla-put-vertcellmargin TblObj 50)
(mapcar '(lambda (x y)(vla-setTextHeight TblObj x y))
(list acTitleRow acHeaderRow acDataRow)
(list 250 250 175))
(mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
(list acTitleRow acHeaderRow acDataRow))
(vla-MergeCells TblObj 0 0 0 2)
(vla-setText TblObj 0 0 "Bang thong ke")
(vla-setText TblObj 1 0 "STT")
(vla-setText TblObj 1 1 "Ten")
(vla-setText TblObj 1 2 "Don vi")
(vla-setText TblObj 1 3 "So luong")
(setq row 2 i 1)
(foreach pt lst_blk
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (car pt))
(vla-setText TblObj row 2 "cai")
(vla-setText TblObj row 3 (itoa (cdr pt)))
(setq row (1+ row) i (1+ i)) ) )
(vlax-release-object TblObj) )
(princ))


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


gia_bach giúp mình với. Cảm ơn bạn
  • 0
-~-~-~-~-~-~-~-~-~-~-~-~-~-~
Hôm qua là sự học hỏi nhận được sau 1 ngày
Ngày mai là sự bí ẩn mà chúng ta sẽ khám phá


------------------------------------------
http://www.tailieukythuat.com

#1126 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 26 April 2010 - 11:07 AM

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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1127 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 26 April 2010 - 11:14 AM

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.
Hình đã gửi

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))

  • 2

#1128 trinhvqh

trinhvqh

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 408 Bài viết
Điểm đánh giá: 222 (khá)

Đã gửi 26 April 2010 - 11:30 AM

"Đượ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: )
  • 0

#1129 trinhvqh

trinhvqh

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 408 Bài viết
Điểm đánh giá: 222 (khá)

Đã gửi 26 April 2010 - 11:39 AM

"Đượ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?
  • 0

#1130 truongthanh

truongthanh

    biết lệnh text

  • Members
  • PipPipPipPip
  • 275 Bài viết
Điểm đánh giá: 7 (bình thường)

Đã gửi 26 April 2010 - 02:48 PM

thanks!
  • 0

#1131 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 27 April 2010 - 12:54 PM

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.c...files/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.
  • 1

#1132 truongthanh

truongthanh

    biết lệnh text

  • Members
  • PipPipPipPip
  • 275 Bài viết
Điểm đánh giá: 7 (bình thường)

Đã gửi 27 April 2010 - 02:44 PM

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!
  • 0

#1133 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 27 April 2010 - 06:21 PM

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é!
  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#1134 mCuongs

mCuongs

    biết zoom

  • Members
  • Pip
  • 17 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 April 2010 - 11:25 PM

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.c...lcalculator.rar
Tên lệnh là : SD_2704
  • 0

#1135 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 28 April 2010 - 01:17 PM

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.c...lcalculator.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.c...o...ost&p=65044
kết quả ghi vào 1 text có sẵn : http://www.cadviet.c...o...ost&p=65338
  • 0

#1136 thuthuypt77

thuthuypt77

    biết pan

  • Members
  • Pip
  • 8 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 April 2010 - 05:17 PM

Bạn chạy thử LISP này :
Update : http://www.cadviet.c...o...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
  • 0

#1137 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 28 April 2010 - 05:50 PM

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

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:
  • 0

#1138 thuthuypt77

thuthuypt77

    biết pan

  • Members
  • Pip
  • 8 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 April 2010 - 06:19 PM

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
  • 0

#1139 damvinhduy

damvinhduy

    biết vẽ line

  • Members
  • PipPip
  • 27 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 28 April 2010 - 06:21 PM

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
  • 0

#1140 queen2k8

queen2k8

    biết pan

  • Members
  • Pip
  • 9 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 April 2010 - 10:01 PM

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.
  • 0