Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Huynh Nghia

Tạo Bảng Thống Kê

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

Huynh Nghia    22

Chào các bạn trên diễn đàn cadviet. Mình có 1 vấn đề rất là nan giải nhờ các bạn giúp dùm, vấn đề là: 

Mình muốn tạo 1 bảng thống kê từ các số cho trước để xác định khối lượng của nó(nếu ta gõ bằng tay với số lượng nhiều thì dễ bị sai xót và tốn rất là nhiều thời gian). Mình có kèm theo file để các bạn dễ hình dung. 

http://www.cadviet.com/upfiles/5/143773_tao_bang_thong_ke.dwg

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
anti lazy    27

Chủ đề thì không khó, nhưng các cao thủ thấy mem mới chủ yếu là xin chứ không chịu học nên đã chán viết lisp free.

Bạn chịu khó tìm trên cadviet, viết lại cho phù hợp. Nếu có thắc mắc, đưa câu hỏi hoặc lisp lên nhờ sửa sẽ có câu trả lời ngay.

Trong bản vẽ có không nhiều loại cần thống kê nên làm tay cũng không lâu lắm.

Các nhanh nhất là dùng phần mềm USD của hai lúa sgcq

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
Huynh Nghia    22

Cảm ơn bạn 

anti lazy đã góp ý, nhưng thú thật mình cũng đã xem các lisp trên diễn đàn, nhưng khả năng không đủ để làm được. Còn nếu làm thủ công thì trong quá trình nhập số liệu dễ bị sai xót lắm và cũng hơi lâu đấy

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
Tr.CongSon    41

Chủ đề không khó nhưng hình như các cao thủ bận hết rồi :)

Giờ thấp thủ như mình giúp bạn được ko ^^

Mình có chút thắc mắc về các bước thực hiện lisp của bạn:

  1. Không chon điểm để chèn bang thong kê thì Lisp biết điểm nào để chèn BTK vào đây bạn :)
  2. Cái khung HCN to đó luôn là Pline hay sao ạ ?
  3. Cái khoảng trống ở giữa còn cái chi nữa hay chỉ có vậy thôi ^^
  4. Cái Item đó luôn là FLASHING hay còn cái tên nào khác??

P/s: Lần sau post bài bạn nhớ đọc nội quy trước đã nhé !

Thanks!

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
Tr.CongSon    41

Comment hồi sang chừ mà không thấy chủ thớt hồi âm luôn .Buồn that !

Đã code xong cho  anh rồi đây

Anh xem thử đúng chưa 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 txt / Lst)
(setq Lst (list (cons 0 "TEXT")
(cons 8 "TAREA")
(cons 7 "Arial")
(cons 10 pt)
(cons 40 31.5)
(cons 41 1)
(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)
(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 pt) (+ (cadr pt) 60))
p6 (list (+ (car pt) 1305) (+ (cadr pt) 60))
)
(TS:Eline p5 p6)
(mapcar 'TS:eText
(list p1 p2 p3 p4)
(list "C" "C" "L" "L")
(list (nth 1 lsttxt) (nth 0 lsttxt) txt_PL 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"))
(setvar "osmode" 1)
(setq pt (getpoint
"\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n B\U+1EA3ng Th\U+1ED1ng K\U+00EA : "
)
i 0
)
(while (setq entblk (TS:sel))
(setq ll (car (TS:Getboundary entblk))
ur (cadr (TS:Getboundary entblk))
item (cdr (assoc 1
(entget (ssname (ssget "W"
ll
ur
(list (cons 0 "TEXT")
(cons 8 "0")
(cons 62 2)
(cons 1 "@*")
)
)
0
)
)
)
)
sstxt (acet-ss-to-list
(ssget "W"
ll
ur
(list (cons 0 "TEXT")
(cons 8 "0")
(cons 62 2)
(cons 1 "#*")
)
)
)
sstxt (vl-sort sstxt
'(lambda (x1 x2)
(< (cadr (assoc 10 (entget x1)))
(cadr (assoc 10 (entget x2)))
)
)
)
lsttxt (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) sstxt)
txt_PL (strcat "PL" (nth 3 lsttxt) "x" (nth 4 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 pt1 (list (car pt1) (- (cadr pt1) (* i 60))))
(setvar "osmode" 0)
(command "_.copy" (entlast) "" "M" pt1 pt2 pt3 pt4 pt5 "")
(setvar "osmode" osm)
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
)
  • Vote tăng 1

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
Huynh Nghia    22

Chủ đề không khó nhưng hình như các cao thủ bận hết rồi :)

Giờ thấp thủ như mình giúp bạn được ko ^^

Mình có chút thắc mắc về các bước thực hiện lisp của bạn:

  1. Không chon điểm để chèn bang thong kê thì Lisp biết điểm nào để chèn BTK vào đây bạn :)
  2. Cái khung HCN to đó luôn là Pline hay sao ạ ?
  3. Cái khoảng trống ở giữa còn cái chi nữa hay chỉ có vậy thôi ^^
  4. Cái Item đó luôn là FLASHING hay còn cái tên nào khác??

P/s: Lần sau post bài bạn nhớ đọc nội quy trước đã nhé !

Thanks!

Bạn Tr.CongSon là người gỡ rối giúp mình rồi, không biết nói lời gì để cảm ơn bạn nữa, cho mình dùng lại từ cảm ơn bạn nhiều nhiều nha! Từ sáng giờ mình đi làm mới về nên mới mở máy và thấy hồi âm của bạn. Thanks bạn một lần nữa! Lisp rất là đúng với ý nguyện của mình rồi. Nhưng mình còn một chỗ nhờ bạn đưa vào lisp dùm là: 1/ khi mình chon các khung block thì dưới dòng command xuất hiên dòng chữ(1 found, 2 found) và khung block sẻ mờ đi(giống như khi mình coppy hay move vậy đó) để mình biết đối tượng nào mình đã chọn rồi. 2/ Trong lisp sẽ bị lỗi nếu ta thay chữ FLASHING thành kí tự số(ví dụ ta thay chữ FLASHING thành 1234) thì lisp sẽ bị lỗi

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
Tr.CongSon    41

4.Cái Item đó luôn là FLASHING hay còn cái tên nào khác??

 

Cái này hôm qua mình hỏi bạn rồi mà ko thấy hồi âm nên phải làm vậy thôi ^^

Để mình nghiên cứu thêm ^^

Code xong mình Gởi cho ^^

P/s: Bạn cảm ơn thì cứ ấn nút thanks cho có tinh thần là được .hehe

  • Vote tăng 1

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
Huynh Nghia    22

Thanks bạn Tr.CongSon trước nha! Tại vì sáng đi làm nên không có mở máy đươc nên không hồi âm bạn được. Với lại nếu bạn chia ra được 2 trường hợp thì giúp mình với(vẫn sử dụng lệnh btk nhưng gặp trường hợp nào thì xuất ra trường hợp đó): 

1/ Nếu 3 cột: LENGTH(LENGTH có số 4000), WIDTH(WIDTH có số 120), THICK(THICK có số 0.5) đầy đủ như này thì xuất ra--->PL120x0.5x4000->thì ok rồi

2/ Nếu 3 cột: LENGTH(LENGTH có số 4000), WIDTH(WIDTH có số 120), THICK(THICK để trống) thì xuất ra---> FL120x4000->bạn giúp mình với

* (Các cột PIECE MARK và QTY vẫn giữ nguyên như bình thường)

  • Vote giảm 1

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
Tr.CongSon    41

Thanks bạn Tr.CongSon trước nha! Tại vì sáng đi làm nên không có mở máy đươc nên không hồi âm bạn được. Với lại nếu bạn chia ra được 2 trường hợp thì giúp mình với(vẫn sử dụng lệnh btk nhưng gặp trường hợp nào thì xuất ra trường hợp đó): 

1/ Nếu 3 cột: LENGTH(LENGTH có số 4000), WIDTH(WIDTH có số 120), THICK(THICK có số 0.5) đầy đủ như này thì xuất ra--->PL120x0.5x4000->thì ok rồi

2/ Nếu 3 cột: LENGTH(LENGTH có số 4000), WIDTH(WIDTH có số 120), THICK(THICK để trống) thì xuất ra---> FL120x4000->bạn giúp mình với

* (Các cột PIECE MARK và QTY vẫn giữ nguyên như bình thường)

Bạn thử xem nhé!

Cuối tuần bận quá nên giờ mới sửa được .

(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 txt / Lst)

(setq Lst (list (cons 0 "TEXT")

(cons 8 "TAREA")

(cons 7 "Arial")

(cons 10 pt)

(cons 40 31.5)

(cons 41 1)

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

(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 pt) (+ (cadr pt) 60))

p6 (list (+ (car pt) 1305) (+ (cadr pt) 60))

)

(TS:Eline p5 p6)

(mapcar 'TS:eText

(list p1 p2 p3 p4)

(list "C" "C" "L" "L")

(list (nth 2 lsttxt) (nth 1 lsttxt) txt_PL (nth 0 lsttxt)))

)

 

;;;;;;;------------------;;;;;;;;;;

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

(setvar "osmode" 1)

(setq pt (getpoint

"\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n B\U+1EA3ng Th\U+1ED1ng K\U+00EA : "

)

i 0

)

(while (setq entblk (TS:sel))

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

)

)

)

sstxt (vl-sort (vl-sort sstxt

'(lambda (x1 x2)

(< (cadr (assoc 10 (entget x1)))

(cadr (assoc 10 (entget x2)))

)

)

)

'(lambda (x1 x2)

(> (caddr (assoc 10 (entget x1)))

(caddr (assoc 10 (entget x2)))

)

)

)

lsttxt (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) sstxt)

)

(if (= (length lsttxt) 6)

(setq txt_PL (strcat "PL" (nth 4 lsttxt) "x" (nth 5 lsttxt) "x" (nth 3 lsttxt)))

(setq txt_PL (strcat "FL" (nth 4 lsttxt) "x" (nth 3 lsttxt))))

(redraw entblk 3)

(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 pt1 (list (car pt1) (- (cadr pt1) (* i 60))))

(setvar "osmode" 0)

(command "_.copy" (entlast) "" "M" pt1 pt2 pt3 pt4 pt5 "")

(setvar "osmode" osm)

(command "regen")

(command "Undo" "End")

(setvar "cmdecho" 1)

(princ)

)

  • Vote tăng 1

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
Huynh Nghia    22

Thanks bạn Tr.CongSon nhiều lắm! Code bạn viết đúng với ý mình rồi, bạn là cao thủ chứ không phải thấp thủ đâu!  :)

Có lisp này mình giảm được sự sai xót khi nhập bằng tay và cũng tiết kiệm được thời gian nữa. Mình có ý này bạn xem thử coi sao nhé! Nhờ bạn hoài mình thấy cũng ngại lắm! Nếu thêm được dòng cuối này vào luôn thì bỏ được 1 công đoạn coppy vào bảng thống kê(hình minh họa).

143773_untitled_3.jpg

  • Vote giảm 2

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
Tr.CongSon    41

Đã sửa xong cho bạn rồi đây ^^

Chúc thành công 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 2 lsttxt) (nth 1 lsttxt) txt_PL (nth 0 lsttxt))
)
)
)
)


;;;;;;;------------------;;;;;;;;;;
(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)
)
)
)
sstxt (vl-sort (vl-sort sstxt
'(lambda (x1 x2)
(< (cadr (assoc 10 (entget x1)))
(cadr (assoc 10 (entget x2)))
)
)
)
'(lambda (x1 x2)
(> (caddr (assoc 10 (entget x1)))
(caddr (assoc 10 (entget x2)))
)
)
)
lsttxt (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) sstxt)
)
(if (= (length lsttxt) 6)
(setq txt_PL (strcat "PL" (nth 4 lsttxt) "x" (nth 5 lsttxt) "x" (nth 3 lsttxt)))
(setq txt_PL (strcat "FL" (nth 4 lsttxt) "x" (nth 3 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)
)
  • Vote tăng 1

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
Huynh Nghia    22

Chào bạn Tr.CongSon!

Trong quá trình làm việc mình có thay đổi kích thước khung block và font trong bock(để tiện hơn trong quá trình làm việc), không biết phải là nguyên nhân gây nên lỗi lsp hay không, bạn xem dùm mình nguyên nhân gây ra lỗi này giúp mình với. Thanks bạn! 

Mình có kèm file để tiện cho bạn kiểm tra. 

http://www.cadviet.com/upfiles/5/143773_loi_khung_lock.dwg

  • Vote giảm 1

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
Tr.CongSon    41

Chào bạn Tr.CongSon!

Trong quá trình làm việc mình có thay đổi kích thước khung block và font trong bock(để tiện hơn trong quá trình làm việc), không biết phải là nguyên nhân gây nên lỗi lsp hay không, bạn xem dùm mình nguyên nhân gây ra lỗi này giúp mình với. Thanks bạn! 

Mình có kèm file để tiện cho bạn kiểm tra. 

http://www.cadviet.com/upfiles/5/143773_loi_khung_lock.dwg

 

Bạn  tìm đoạn này:

(acet-ss-to-list
     (ssget "W"
    ll
    ur
    (list (cons 0 "TEXT")
   (cons 8 "0")
   (cons 62 2)
    )
     )
  )
Rồi thêm dấu ; vào trước  (cons 62 2) hoặc delete (cons 62 2) đi là được
  • Vote tăng 1

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
Tr.CongSon    41

Do diễn đàn bị lỗi nên bạn đọc cmt không được đó.

Bạn Click vào nút trả lời sẽ thấy :)

Chúc bạn thành công nhé!

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
Huynh Nghia    22

 

Bạn  tìm đoạn này:

(acet-ss-to-list
     (ssget "W"
    ll
    ur
    (list (cons 0 "TEXT")
   (cons 8 "0")
   (cons 62 2)
    )
     )
  )
Rồi thêm dấu ; vào trước  (cons 62 2) hoặc delete (cons 62 2) đi là được

 

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! 

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
Tr.CongSon    41

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

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
Huynh Nghia    22

Đã 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! 

  • Vote giảm 2

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
Tr.CongSon    41

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)

)

  • Vote tăng 1

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×