Đến nội dung


Hình ảnh
- - - - -

Sửa giùm mình lisp


  • Please log in to reply
19 replies to this topic

#1 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 26 July 2014 - 03:14 PM

Mình hiện giờ có lisp này để tính khối lượng thép của 1 số thép hình ..cách dùng với các đối tượng dtext là : chọn số lượng , chọn kích thước(vi dụ :L150x90x9x9-7894L), chọn text để chèn uint weight, chọn text để chèn total weight..Mỗi lần chọn là 1 lần enter..sau đó lisp sẽ tự tính và chèn khối lượng vào..
Bây giờ mình muốn sửa để có thêm mục chọn chiều dài..bởi vì mỗi lần tính thì lại phải joint text (ví dụ phải joint L100x90x9x9 với 7894 thành L150x90x9x9-7894L) thì mới có thể tính toán bằng lisp kia đc..
Vậy up lisp lên đây nhờ các pro giúp đỡ..thanks!

http://www.mediafire...aw4nt188/BW.lsp


  • 0

#2 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 27 July 2014 - 10:51 AM

có vẻ khó..

vậy nên pro nào viết giùm mình cái list nối "text1" vs "text2" thành 1 text có dạng "text1-text2L"

Mình cũng có cái lisp join text dưới đây nhưng nó ko chạy được cho nhiều text cùng lúc..vậy nhờ pro nào sửa này chạy nhiều text 1 lúc, thứ tự kết nối là chạy theo vòng lặp cứ text1 hàng 1 nối với text2 hàng 2, nếu 2 cột text số lượng ko bằng nhau thì báo lỗi..

Thank!

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...-1-mtext-khong/
(defun C:jt (/ i ent obj  obj1 ss btwtxt )
 (vl-load-com)  
 (princ "\nSelect First Text or MText Entity: ")
 (while (not (and (setq ss (ssget (list (cons 0 "TEXT,MTEXT"))))
				  (setq ent (ssname ss 0))
				  (setq obj1 (vlax-ename->vla-object ent))
			 )
		)
  (princ "\nError with selection please select again: ")  
 )
 (if(=(cdr(assoc 0 (entget ent))) "MTEXT")
  (setq btwtxt "\\P") ;Return in MText.
  (setq btwtxt "-")   ;Or space between Text selections.
 )
 (redraw(ssname(ssget "P")0)3) ;Highlight First selection.
 (princ "\nSelect text or mtext entities to add to first: ")	  
 (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))
	   ss (ssget ":S" (list (cons 0 "TEXT,MTEXT")))
	   i 0 ;Start with first selection.
 )
 (if(ssmemb ent ss)(ssdel ent ss))
 ; Don't delete First selection if selected again.
 (repeat (sslength ss)
  (vla-startundomark thisdrawing)
  (setq ent (ssname ss i)
		obj (vlax-ename->vla-object ent)
		i	 (1+ i) ;increment to next selection.
  )
  (if(= btwtxt " ")
   (while(vl-string-search "\\P" (vla-get-textstring obj))
(vla-put-textstring obj
(vl-string-subst " " "\\P" (vla-get-textstring obj))
)
   )
  )
  (vla-put-textstring obj1 
(strcat 
 (vla-get-textstring obj1)
 btwtxt
(vla-get-textstring obj) 
"L"
 ) 
  )
  (vla-delete obj)
  (vla-endundomark thisdrawing)
 )
 (princ)
)

  • 0

#3 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 27 July 2014 - 11:39 AM

Bạn phải gửi file dwg thì mới biết hàng,cột, text, số lượng như thế nào.


  • 1

#4 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 27 July 2014 - 12:03 PM

số lượng cột thì luôn luôn là 2, còn số lượng hàng thì tuỳ biến..chỉ cần số hàng bằng nhau là đc, nó cứ nối 2 text cùng 1 hàng là đc..Thank..

Thực ra vấn đề ở đây là cái lisp tính Bom ở #1, cái đó nó chỉ nhận profile thép hình dưới dạng "profile-chiều dài L"(ví dụ "L90x90x9x9-1234L)..trong khi đó list vật liệu thường có cột chiều dài..vì vậy nếu ko sửa đc lisp ở #1 thì đành dùng thêm 1 lisp phụ ở #2 đó là nối 2 text "profile" và "chiều dài" thành dạng "profile-chiều dài L"..

File cad: 

https://www.mediafir...t2djx1n684pnxky


  • 0

#5 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 27 July 2014 - 01:37 PM

Bạn dùng cái này, chỉ quét 2 cột profile và chiều dài thôi, cái nào có chiều dài thì nó mới nối.

(defun C:nt(/ tm tm1 cao)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (setq tm (vl-sort (mapcar '(lambda(x) (list (dxf 11 x) x))
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
  '(lambda (x y) (< (cadar x) (cadar y))))
cao (dxf 40 (last (car tm))))
  (while tm
    (setq tm1 (vl-sort (vl-remove-if-not
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm)
    '(lambda (x y) (< (caar x) (caar y)) )) 
 tm (vl-remove-if
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm))
    (if (= (length tm1) 2)
      (entmod (subst
(cons 1 (strcat (dxf 1 (last (car tm1))) "-" (dxf 1 (last (last tm1))) "L"))
(assoc 1 (entget (last (car tm1)))) (entget (last (car tm1)))))
    )
  ) (princ)
)

  • 1

#6 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 27 July 2014 - 02:39 PM

^..Thank bạn rất nhiều..nếu bạn ở HP thì mình mời đi uống cafe trả công  B)

P/S : giá mà sửa đc cái list tính BOM ở trên thì hay..đỡ khỏi qua bước trung gian này..hix.. :P


  • 0

#7 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 27 July 2014 - 03:11 PM

Tiện thể pro cho mình hỏi thêm là liệu có thể viết lisp thay vì nối 2 cột text như trên thì có thể tính toán cộng trừ nhân chia 2 cột đấy cho nhau và xuất kết quả ra cột thứ 3 ko?

Trình tự như nhau :

-chọn các phần tử cột 1

-nhập phép tính (+,-,x,/)

-chọn các phần tử cột 2

-thực hiện tính toán : phần tử cột 1 (+,-,x,/) phần tử cột 2

-xuất kết quả

Thank!


  • 0

#8 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 27 July 2014 - 04:09 PM

Vậy sửa cái lisp trên chút xíu. Cứ quét hết 3 cột rồi nhập phép tính +-*/ . Không cần phải quét từng cột nếu 3 cột sát nhau.

 

(defun C:tinh(/ tm tm1 cao)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (setq tm (vl-sort (mapcar '(lambda(x) (list (dxf 11 x) x))
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
  '(lambda (x y) (< (cadar x) (cadar y))))
cao (dxf 40 (last (car tm)))
ptinh (getstring "\nPhep tinh:"))
  (while tm
    (setq tm1 (vl-sort (vl-remove-if-not
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm)
    '(lambda (x y) (< (caar x) (caar y)) )) 
 tm (vl-remove-if
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm))
    (if (= (length tm1) 3)
      (entmod (subst 
(cons 1 (rtos ((eval (read ptinh)) (atof (dxf 1 (last (car tm1))))
     (atof (dxf 1 (last (cadr tm1)))))))
(assoc 1 (entget (last (last tm1)))) (entget (last (last tm1)))))
    )
  ) (princ)
)

  • 1

#9 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 27 July 2014 - 04:57 PM

Hehe..thank bạn nhiều nha .. :P


  • 0

#10 phamhuy1

phamhuy1

    biết vẽ rectang

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

Đã gửi 27 July 2014 - 05:51 PM

anh nevercry_hp ơi !  cho em xin các file    "E_HD" "E_HE" "E_HP" "E_HL" "E_IPE" "E_IPN"
       "E_L" "E_U" "E_UPE" "E_UPN" "E_BW"   chạy kèm khi load   BW.lsp đi. Thanks! :)


  • 0

#11 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 28 July 2014 - 07:40 AM

anh nevercry_hp ơi !  cho em xin các file    "E_HD" "E_HE" "E_HP" "E_HL" "E_IPE" "E_IPN"
       "E_L" "E_U" "E_UPE" "E_UPN" "E_BW"   chạy kèm khi load   BW.lsp đi. Thanks! :)

Cái này trong bộ lisp của cty ..a đang làm cho doosan..để tý tìm up cho..hehe..ko biết thế này có phải là tuồn tài liệu cty ra ngoài ko nhỉ..!!Chủ yếu là dùng chuẩn astm thôi, chuẩn khác ko có đâu..


  • 0

#12 phamhuy1

phamhuy1

    biết vẽ rectang

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

Đã gửi 28 July 2014 - 08:32 AM

Thank anh nevercry_hp trước nha! :)


  • 0

#13 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 28 July 2014 - 09:07 AM

Đây của bạn đây..mà bạn lấy lisp này về làm gì vậy?  :D

https://www.mediafir...qac3scqy4xeyqqm


  • 1

#14 phamhuy1

phamhuy1

    biết vẽ rectang

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

Đã gửi 28 July 2014 - 10:14 AM

Em muốn biết thêm về chuẩn astm thép hình, với lại thấy cái lisp BW.lsp của anh có mục load các file này mà mình ko có nên tò mò là sao phải có hàm load-files.lsp để load các file này???Thanks! :D


  • 0

#15 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 28 July 2014 - 10:22 AM

Em muốn biết thêm về chuẩn astm thép hình, với lại thấy cái lisp BW.lsp của anh có mục load các file này mà mình ko có nên tò mò là sao phải có hàm load-files.lsp để load các file này???Thanks! :D

Cái lisp này chỉ để tính KL vật tư chả có gì đâu..Chuẩn ASTM trên mạng đầy, thiếu gì..Cái lisp nó chỉ hỗ trợ thay cho việc ngồi tra bảng, nhân chiều dài ra kl thôi..Nói chung là vậy

Đang muốn sửa cái lisp..thuật toán thì có trong đầu nhưng chuyển thành lisp thì ko đc..hix


  • 0

#16 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 28 July 2014 - 10:45 AM

Hix..sao mình dùng lisp nối text và tính toán với file cad lại ko đc nhỉ, nó chỉ làm đc từng hàng 1 chứ ko làm đc cả hàng?trong khi đó các file kia lại đc??!!

https://www.mediafir...rospx2owoulnodq

Thank!


  • 0

#17 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 28 July 2014 - 11:02 AM

Vì trong file này text của bạn là canh trái, còn file trước không canh trái.

Chính vì vậy mỗi khi viết líp thì phải hỏi đưa file lên là vậy đó. 

Trong bảng thật sự khi làm việc của bạn thì text canh thế nào?


  • 1

#18 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 28 July 2014 - 01:37 PM

^..

tại nhiều bản vẽ nó lung tung lắm, nhiều khi ko đúng chuẩn...vậy nên có cách nào dùng thuật toán khác đc ko nhỉ..?

Thank..


  • 0

#19 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 28 July 2014 - 02:09 PM

Cũng chẳng có gì, sửa lại chút thôi.

(defun C:nt(/ tm tm1 cao)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun txt1011 (x) (if (= 0 (distance (dxf 11 x) '(0 0))) (dxf 10 x) (dxf 11 x)))
  (setq tm (vl-sort (mapcar '(lambda(x) (list (txt1011 x) x))
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
  '(lambda (x y) (< (cadar x) (cadar y))))
cao (dxf 40 (last (car tm))))
  (while tm
    (setq tm1 (vl-sort (vl-remove-if-not
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm)
    '(lambda (x y) (< (caar x) (caar y)) )) 
 tm (vl-remove-if
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm))
    (if (= (length tm1) 2)
      (entmod (subst
(cons 1 (strcat (dxf 1 (last (car tm1))) "-" (dxf 1 (last (last tm1))) "L"))
(assoc 1 (entget (last (car tm1)))) (entget (last (car tm1)))))
    )
  ) (princ)
)
 
(defun C:tinh(/ tm tm1 cao)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun txt1011 (x) (if (= 0 (distance (dxf 11 x) '(0 0))) (dxf 10 x) (dxf 11 x)))
  (setq tm (vl-sort (mapcar '(lambda(x) (list (txt1011 x) x))
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*TEXT")))))))
  '(lambda (x y) (< (cadar x) (cadar y))))
cao (dxf 40 (last (car tm)))
ptinh (getstring "\nPhep tinh:"))
  (while tm
    (setq tm1 (vl-sort (vl-remove-if-not
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm)
    '(lambda (x y) (< (caar x) (caar y)) )) 
 tm (vl-remove-if
'(lambda(x) (equal (cadr (caar tm)) (cadar x) cao)) tm))
    (if (= (length tm1) 3)
      (entmod (subst 
(cons 1 (rtos ((eval (read ptinh)) (atof (dxf 1 (last (car tm1))))
     (atof (dxf 1 (last (cadr tm1)))))))
(assoc 1 (entget (last (last tm1)))) (entget (last (last tm1)))))
    )
  ) (princ)
)

  • 1

#20 nevercry_hp

nevercry_hp

    biết zoom

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

Đã gửi 29 July 2014 - 07:50 AM

OK...thank nhiều nhé..


  • 0