Đến nội dung


Hình ảnh

Tạo Bảng Thống Kê


  • Please log in to reply
23 replies to this topic

#21 Tr.CongSon

Tr.CongSon

    biết lệnh array

  • Members
  • PipPipPip
  • 183 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 22 August 2015 - 04:21 PM

Mình đã làm theo cách của bạn rồi, nhưng thứ tự các cột nó bị nhảy lộn xộn hết luôn, mong bạn chỉ thêm. Thanks! 

 

Đã tìm ra nguyên nhân ,do mình sắp xếp các text theo chiều tăng của X nên nó bị lỗi

Bạn sửa điểm chèn của Text ở cột piece Mark = với 4 Text ngang là được :)


  • 0

#22 Huynh Nghia

Huynh Nghia

    biết vẽ ellipse

  • Members
  • PipPip
  • 52 Bài viết
Điểm đánh giá: -22 (kém)

Đã gửi 23 August 2015 - 08:25 PM

Đã tìm ra nguyên nhân ,do mình sắp xếp các text theo chiều tăng của X nên nó bị lỗi

Bạn sửa điểm chèn của Text ở cột piece Mark = với 4 Text ngang là được :)

Bạn Tr.CongSon có thể nói rõ hơn không? Do mình không rành về lsp nên không biết sữa chỗ nào trong lsp hết. Mong tin từ bạn. Thanks bạn! 


  • -2

#23 Tr.CongSon

Tr.CongSon

    biết lệnh array

  • Members
  • PipPipPip
  • 183 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 24 August 2015 - 08:10 AM

Bạn Tr.CongSon có thể nói rõ hơn không? Do mình không rành về lsp nên không biết sữa chỗ nào trong lsp hết. Mong tin từ bạn. Thanks bạn! 

 

Ộc ộc.Cái mình biểu bạn sửa là cái Text trong bản vẽ của bạn chứ đâu phải trong Lisp :)

Sửa luôn cho bạn rồi đây

Tên lệnh như cũ 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 witdh txt / Lst)
(setq Lst (list (cons 0 "TEXT")
(cons 8 "TAREA")
(cons 7 (getvar "textstyle"))
(cons 10 pt)
(cons 40
(if (= (getvar "textstyle") "Romans")
30
31.5
)
)
(cons 41 witdh)
(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 p7 p8)
(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 point) (+ (cadr point) 60))
p6 (list (+ (car point) 1305) (+ (cadr point) 60))
)
(TS:Eline p5 p6)
(if (null entblk)
(progn
(setq p7 (list (+ (car point) 990) (+ (cadr point) 30))
p8 (list (+ (car point) 1200) (+ (cadr point) 30))
)
(TS:Eline point (list (+ (car point) 1305) (cadr point)))
(setvar "Textstyle" "ROMANS")
(mapcar 'TS:eText
(list p1 p2 p3 p7 p8)
(list "C" "C" "L" "C" "C")
(list 0.75 0.6 0.75 0.6 0.6)
(list "Q.TY" "PIECE MARK" "MATERIAL DESCRIPTION" "UNIT WEIGHT" "ELEMENT WT.")
)
)
(progn
(setvar "Textstyle" "Arial")
(mapcar 'TS:eText
(list p1 p2 p3 p4)
(list "C" "C" "L" "L")
(list 1 1 1 1 1)
(list (nth 1 lsttxt) (nth 0 lsttxt) txt_PL txt_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")
tstyle (getvar "Textstyle")
)
(setvar "osmode" 1)
(if (not (tblsearch "Style" "Arial"))
(command "_.STYLE" "Arial" "Arial" "0" "1" "0" "No" "No")
)
(if (not (tblsearch "Style" "Romans"))
(command "_.STYLE" "Romans" "Romans" "0" "0.6" "0" "No" "No" "No")
)
(setq pt (getpoint
"\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n B\U+1EA3ng Th\U+1ED1ng K\U+00EA : "
)
i 0
)
(TS:MakeBTK pt)
(setq pt (list (car pt) (+ (cadr pt) 60)))
(while (setq entblk (TS:sel))
(redraw entblk 3)
(setq ll (car (TS:Getboundary entblk))
ur (cadr (TS:Getboundary entblk))
sstxt (acet-ss-to-list
(ssget "W"
ll
ur
(list (cons 0 "TEXT")
(cons 8 "0")
;;; (cons 62 2)
)
)
)
ssitem (car (vl-sort sstxt
'(lambda (x1 x2)
(> (caddr (assoc 10 (entget x1)))
(caddr (assoc 10 (entget x2)))
)
)
)
)
sstxt (vl-sort (vl-remove ssitem sstxt)
'(lambda (x1 x2)
(< (cadr (assoc 10 (entget x1)))
(cadr (assoc 10 (entget x2)))
)
)
)
txt_item (cdr (assoc 1 (entget ssitem)))
lsttxt (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) sstxt)
)
(if (= (length lsttxt) 5)
(setq txt_PL (strcat "PL" (nth 3 lsttxt) "x" (nth 4 lsttxt) "x" (nth 2 lsttxt)))
(setq txt_PL (strcat "FL" (nth 3 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 pt (list (car pt) (- (cadr pt) (* (1+ i) 60))))
(setvar "osmode" 0)
(command "_.copy" (entlast) "" "M" pt pt1 pt2 pt3 pt4 pt5 "")
(setvar "osmode" osm)
(setvar "Textstyle" tstyle)
(command "regen")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
)


  • 1

#24 Huynh Nghia

Huynh Nghia

    biết vẽ ellipse

  • Members
  • PipPip
  • 52 Bài viết
Điểm đánh giá: -22 (kém)

Đã gửi 24 August 2015 - 07:09 PM

Cảm ơn bạn Tr.CongSon nhiều lắm! 


  • 0