Chuyển đến nội dung
Diễn đàn CADViet
Nguyen Hoanh

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

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

Em muốn nhờ các bác làm hộ cái lisp khi mà mình fillet 2 đường thì phần đườngthằngmới tạo ra để fillet là line khác (chứ ko phải là 2 đường cũ) layer có thể là layer hiện thời, chứ ko phải là layer của 2 đường gôc

 

3L0.9692507_1_1.png

 

Cảm ơn các bác nha

Từ Lisp ghi kích thước vạt góc giúp cho truongthanh -> Tue_NV chỉnh lại 1 chút cho phù hợp với yêu cầu của bạn vansulich

vansulich hãy thử code này nhé :

(defun c:gktvg(/ p1 p2 ss1 ss2 prad1 prad2 p11 p22 inte)
;copyright by Tue_NV
(vl-load-com)
(setq p1 (getpoint "\n Chon diem cuoi fillet thu nhat :"))
(setq p2 (getpoint "\n Chon diem cuoi fillet thu hai :"))
(setq ss1 (car(nentselp p1)))
(setq ss2 (car(nentselp p2)))
(setq prad1 (fix (vlax-curve-getParamAtPoint ss1 p1)))
(setq prad2 (fix (vlax-curve-getParamAtPoint ss2 p2)))
 (if (= prad1 0) 
(setq p11 (vlax-curve-getPointAtParam ss1 (+ prad1 1)))
(setq p11 (vlax-curve-getPointAtParam ss1 (- prad1 1)))
 )
 (if (= prad2 0) 
(setq p22 (vlax-curve-getPointAtParam ss2 (+ prad2 1)))
(setq p22 (vlax-curve-getPointAtParam ss2 (- prad2 1)))
 )
(if (setq inte (inters p11 p1 p2 p22 nil))
(progn
    (command "line" p1 inte "")
    (command "line" p2 inte "")
)
(alert "\n 2 duong song song. Khong the fillet duoc")
)
(princ)
)

@Truongthanh : Nhìn file của bạn -> Tue_NV vẫn không hiểu kết quả mà bạn muốn. Có lẽ mình không thuộc vào chuyên ngành của bạn. Có lẽ là vậy. Nhưng dù sao, bạn muốn người khác giúp cho bạn thì ít ra bạn phải nói rõ hơn cái kết quả bạn muốn chứ? Bạn muốn tính diện tích phần nào? Diện tích giải toả nhà nằm giữa phần ranh giới giữa đường hiện trạng và đường quy hoạch chăng? Mong bạn nói rõ ràng nhé.

  • 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
@Truongthanh : Nhìn file của bạn -> Tue_NV vẫn không hiểu kết quả mà bạn muốn. Có lẽ mình không thuộc vào chuyên ngành của bạn. Có lẽ là vậy. Nhưng dù sao, bạn muốn người khác giúp cho bạn thì ít ra bạn phải nói rõ hơn cái kết quả bạn muốn chứ? Bạn muốn tính diện tích phần nào? Diện tích giải toả nhà nằm giữa phần ranh giới giữa đường hiện trạng và đường quy hoạch chăng? Mong bạn nói rõ ràng nhé.

đúng rồi đó TUE_NV ơi!chính là phần diện tích đó đó!xin lỗi bạn vì khả năng diễn đạt của mình hơi ké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
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))

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

Nhưng nhờ bạn xem lại giúp mình đã xảy ra lỗi không sử dụng được

 

Command: BlkQty

 

Select objects: Specify opposite corner: 4 found

 

Select objects:

 

Diem dat Bang :; error: Automation Error. Invalid input

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
Cảm ơn gia_bach đã quan tâm.

Nhưng nhờ bạn xem lại giúp mình đã xảy ra lỗi không sử dụng được

 

Command: BlkQty

 

Select objects: Specify opposite corner: 4 found

 

Select objects:

 

Diem dat Bang :; error: Automation Error. Invalid input

Có vẻ như bạn sử dụng CAD đời cũ (CAD2004). :undecided:

lệnh tạo bảng (Table) chỉ sử dụng được từ CAD 2005 trở đ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
........ xin nhờ bác GIA BACH giúp dùm em với!
...............................

@Truongthanh : Nhìn file của bạn -> Tue_NV vẫn không hiểu kết quả mà bạn muốn. Có lẽ mình không thuộc vào chuyên ngành của bạn. Có lẽ là vậy. Nhưng dù sao, bạn muốn người khác giúp cho bạn thì ít ra bạn phải nói rõ hơn cái kết quả bạn muốn chứ? Bạn muốn tính diện tích phần nào? Diện tích giải toả nhà nằm giữa phần ranh giới giữa đường hiện trạng và đường quy hoạch chăng? Mong bạn nói rõ ràng nhé.

Rất tiếc, nhìn file của bạn tui không hiểu bạn muốn gì ? :undecided:

Đồng ý kiến với Tue_NV .

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
Có vẻ như bạn sử dụng CAD đời cũ (CAD2004). :undecided:

lệnh tạo bảng (Table) chỉ sử dụng được từ CAD 2005 trở đi.

Mình sử dụng CAD 2007 bạn à. Nhờ bạn kiểm tra lại dùm

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
Rất tiếc, nhìn file của bạn tui không hiểu bạn muốn gì ? :undecided:

Đồng ý kiến với Tue_NV .

em ghi rất rõ rồi mà!em muốn tính phần diện tích giữa đường Quy Hoạch và đường hiện trạng!

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 đã thử rồi. Chạy tốt. Không có vấn đề gì.

File HoangSon upload đã được Tue_NV thử :

thong ke vat tu da thu

Vậy là lỗi do đâu, Tue_NV giải thích dùm mình được không?

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
em ghi rất rõ rồi mà!em muốn tính phần diện tích giữa đường Quy Hoạch và đường hiện trạng!

 

Thật khổ!

Lại phải ca bài "Em không hiểu hay cố tình không hiểu?"

 

Theo tôi biết yêu cầu này của bạn gia_bach sẽ giải quyết được thôi

Hãy chịu khó mà bám lấy các cao thủ bạn nhé! :undecided:

Cù nhầy một lúc rồi việc gì cũng xong thôi.

  • 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
Vậy là lỗi do đâu, Tue_NV giải thích dùm mình được không?

 

Có khi bạn xài Win64 giống tôi

Với Wim32 thì lisp của gia_bach rất ok

Nhưng với win64 không hiểu sao đôi lúc nó hay bị "cà tưng"

 

Lỗi phải thế nào thì không hiểu nữa bạn ạ

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
Đây là kết quả của Lisp : thong_ke_dien

Ban có thể Upload file lên diễn đàn ?

 

Đây bạn, xem giúp mình

thong_ke_vat_tu

 

gia_bach xem giúp minh với, mình đang cần lắm. Cảm ơn bạn

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
Có khi bạn xài Win64 giống tôi

Với Wim32 thì lisp của gia_bach rất ok

Nhưng với win64 không hiểu sao đôi lúc nó hay bị "cà tưng"

 

Lỗi phải thế nào thì không hiểu nữa bạn ạ

Mình sử dụng Win 32 bạn à, nhưng không hiểu sao nữa, bực mình quá

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
Mình sử dụng Win 32 bạn à, nhưng không hiểu sao nữa, bực mình quá

Đừng bực mình nữa mờ :undecided:

Bạn sử dụng code này thử xem :

Code này là của bác phamthanhBinh đã được Tue_NV chỉnh lại cho phù hợp với yêu cầu của HoangSon.

Tuy nhiên mình vẫn thích sử dụng cách lập bảng như code của anh gia bach hơn

HoangSon thử nhé :

(defun c:tkck (/ ltxt ltst)
(command "undo" "be")
(setq ss (ssget (list (cons 0 "insert")))
ltxt (list)
ltst (list)
i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq ltxt (append ltxt (list(cdr (assoc 2 (entget ent)))))))
(foreach x ltxt
(if (setq old (cdr (assoc x ltst)))
(setq ltst (subst (cons x (1+ old) ) (assoc x ltst) ltst))
(setq ltst (append ltst (list (cons x 1))))))
(setq k 1
p (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao text: ")
d (getreal "\n Nhap do rong cot: "))
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 h) (cons 1 "THONG KE CAU KIEN")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "STT")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) d) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "TEN CAU KIEN")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 2 d)) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "SO LUONG")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 3 d)) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "GHI CHU")))
(foreach x1 ltst
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (rtos k 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) d) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (car x1))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 2 d)) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (rtos (cdr x1) 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 3 d)) (- (cadr p) (* 2 h (1+ k)))))
(cons 40 h) (cons 1 "" )))
(setq k (1+ k)))
(command "undo" "e")
(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
Nataca có thể share lisp nào tương tự cho đường 3d ko? Mấy cái này thì cần thiết cho việc san nền lắm đây, việc kiểm tra trở nên khá đơn giản và dể dàn

Thanks

P/S: lâu nay vẫn khoẻ chứ? Công việc thế nào rồi?

Mình chưa hiểu ý của Philipdn lắm. Cậu có thể nói cụ thể hơn được không?

@: Tớ dạo này hơi ốm yếu vì việc ngập đầu. Không làm thì ko có ăn, việc nhiều thì cũng chết. Thế đấy :undecided:

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
Đừng bực mình nữa mờ :undecided:

Bạn sử dụng code này thử xem :

Code này là của bác phamthanhBinh đã được Tue_NV chỉnh lại cho phù hợp với yêu cầu của HoangSon.

Tuy nhiên mình vẫn thích sử dụng cách lập bảng như code của anh gia bach hơn

HoangSon thử nhé :

(defun c:tkck (/ ltxt ltst)
(command "undo" "be")
(setq ss (ssget (list (cons 0 "insert")))
ltxt (list)
ltst (list)
i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq ltxt (append ltxt (list(cdr (assoc 2 (entget ent)))))))
(foreach x ltxt
(if (setq old (cdr (assoc x ltst)))
(setq ltst (subst (cons x (1+ old) ) (assoc x ltst) ltst))
(setq ltst (append ltst (list (cons x 1))))))
(setq k 1
p (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao text: ")
d (getreal "\n Nhap do rong cot: "))
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 h) (cons 1 "THONG KE CAU KIEN")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "STT")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) d) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "TEN CAU KIEN")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 2 d)) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "SO LUONG")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 3 d)) (- (cadr p) (* 2 h))))
(cons 40 h) (cons 1 "GHI CHU")))
(foreach x1 ltst
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (rtos k 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) d) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (car x1))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 2 d)) (- (cadr p) (* 2 h (+ 1 k)))))
(cons 40 h) (cons 1 (rtos (cdr x1) 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car p) (* 3 d)) (- (cadr p) (* 2 h (1+ k)))))
(cons 40 h) (cons 1 "" )))
(setq k (1+ k)))
(command "undo" "e")
(princ)
)

Cảm ơn Tue_NV. Nhưng nếu code trên mà kẻ thêm khung nữa thì hay biết mấy (nói chung mình rất tiếc code của gia_bach)

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

Chào Truongthanh

Bản vẽ của bạn không rõ ràng. Bạn muốn tính diện tích nhà? Có lẽ rằng bạn nên mô tả rất cụ thể, chi tiết để 1 người đọc dù ngu dốt đến đâucũng có thể hiểu được bạn muốn gì? Diện tích nhà bạn cần tính giữa đường Quy Hoạch và đường hiện trạng?Không hiểu kếtquả mà truongthanh mong muốn. Kết quả mà bạn mong muốn sao bạn không thể hiện trên bản vẽ. Bạn nên hatch vào diện tích nhà cần tính và chỉ rõ đâu là nhà? Kết quả bạn muốn là gì??? Chịu, không hiểu thì muốn giúp cũng chẳng làm được gì 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
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ỉ?)

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

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

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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×