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

[Tue_NV 3.912]

Dạ, đường ống dài đi qua các nút 18,21,25,31,30 em đã cắt từ khi sử dụng lisp tính chiều dài của bác Bình. Vừa rồi em cũng sửa lại nhưng em vẫn chưa chạy được lisp. Nhờ anh Thiệp check giùm:

 

"Command: svba

 

Select objects: Specify opposite corner: 644 found

 

Select objects:

 

Chon do cao text : 20

bad argument type: lselsetp nil"

Check thử cho svba đây :

http://www.cadviet.com/upfiles/2/a_4_1.dwg

Khi sử dụng Lisp của bác Thiep thì các đường nối 2 điểm nút phải cắt qua Text Nút, nếu không cắt thì không thử được.

Hơn nữa -> để Lisp chạy đúng chiều mũi tên (từ điểm nút này đến điểm nút kia) thì nút đầu phải trùng với Startpoint; nút cuối phải trùng với Endpoint.

 

Lisp sau sẽ giúp svba KTRA những đường PLINE nối điểm nút, Nếu PLINE nối điểm đầu và điểm cuối có 2 TEXT thuộc LAYER sttkhu thì đúng, ngược lại đó là những PLINE chưa đúng, đồng thời LISP sẽ đánh point điểm đầu của PLINE màu xanh, PLINE điểm cuối màu đỏ để svba dễ dàng kiểm tra.

svba thử nhé :

 
(defun c:ktra(/ laytn laysttnut oldpo oldla oldos ss i lstLWP sst)
 (command "undo" be)
 (setq laytn "thoatnuoc")
 (setq laysttnut "sttnut")
 (setq oldpo (getvar "pdmode"))
 (setq oldla (getvar "clayer"))
 (setq oldos (getvar "osmode"))
 (setvar "cmdecho" 0)
 (setvar "pdmode" 3)
 (setvar "pdsize" 5)
 (setvar "osmode" 0)
 (command "Layer" "N" "KTRA" "S" "KTRA" "")
 (setq ss (ssget (list (cons 0 "*POLYLINE") (cons 8 laytn))) i 0)
 (while (    (setq lstLWP (ACET-GEOM-VERTEX-LIST (ssname ss i)))
(setq sst (ssget "f" lstLWP (list (cons 0 "TEXT") (cons 8 laysttnut))))
  (if (or (= sst nil)
	  (= (sslength sst) 1)
	  (> (sslength sst) 2)
      )
   		(vlax-put (vlax-ename->vla-object (ssname ss i)) 'color 2)
  )
   	(command "point" (car lstLWP))
   	(vlax-put (vlax-ename->vla-object (entlast)) 'color 3)
   	(command "point" (last lstLWP))
   	(vlax-put (vlax-ename->vla-object (entlast)) 'color 1)
   (setq i (1+ i))
  );while
 (setvar "pdsize" (/ (cdr(assoc 40 (entget (ssname sst 0)))) 2))
 (setvar "clayer" oldla)
 (setvar "osmode" oldos)
 (command "undo" end)
);defun

PS : Nếu em đã lỡ đánh số thứ tự điểm nút không cùng chiều với mũi tên thì có thể sử dụng Lisp đổi chiều PLINE của bác Hoành đã viết trên diễn đàn mình.

Chúc thành công :D

[thiep 365]

Dạ, đường ống dài đi qua các nút 18,21,25,31,30 em đã cắt từ khi sử dụng lisp tính chiều dài của bác Bình. Vừa rồi em cũng sửa lại nhưng em vẫn chưa chạy được lisp. Nhờ anh Thiệp check giùm:

 

"Command: svba

 

Select objects: Specify opposite corner: 644 found

 

Select objects:

Chon do cao text : 20
bad argument type: lselsetp nil"[/quote]
Chào svba, A Thiep thấy có sự khác nhau về câu hỏi: lisp của anh hỏi: "Chon do cao text <20> :"
Còn lisp svba chạy thì hỏi: "Chon do cao text : " là sao vậy sao kà!
Thôi thì svba tạm thử lại lisp svb.lsp này xem. Nên nhớ cài Express tool nhé

;| Lisp thong ke duong ong nuoc
copyright by thiep 03/2010|;
;;;-------------------------------------------
(defun SS-entlst (ss / c L)
 (setq c -1)
 (repeat (sslength ss)
   (setq L (cons (ssname ss (setq c (1+ c)))
	  L
    )
   )
 )
 (reverse L)
)
;;;----------------------------------
(defun filter (lstent otype olayer / kq)
 (foreach pp lstent
    (setq tt (entget pp))
    (if (and
   (member (cons 0 otype) tt)
   (member (cons 8 olayer) tt)
 )
      (setq kq (append kq (list pp)))
    )
 )
 kq
)
;;;======================
(defun timgan (p lst / dmin ppluu)
 (foreach pp lst
   (setq d (distance p pp))
   (if	(or (not dmin) (> dmin d))
     (setq dmin d
    ppluu pp
     )
   )
 )
 ppluu
)
;;;======================
(defun dxf (code ent)
 (cdr (assoc code (entget ent)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SAVE_MODE ()
 (setq	OLD_OSMODE    (getvar "OSMODE")
OLD_ORTHOMODE (getvar "ORTHOMODE")
 )
 (setvar "cmdecho" 0)
 (setvar "OSMODE" 0)
)
(defun RESTORE ()
 (setvar "osmode" OLD_OSMODE)
 (setvar "ORTHOMODE" OLD_ORTHOMODE)
)
;|===========================================================
                     MAIN LISP                              
===========================================================|;
(defun c:svb (/ lstent	   lstLWP_tn lstLWP_vh lsttextt	 tsi
	 Tstyle	   lstpoCP   lstenttext		 lstLWP_vh_text
	 TblObj	   p1	     rows      nRow	 nCol
	 objLwp	   lstpoF    len       midpo	 param
	 ang	   mfen1     mfen2     ss	 lstLWP2
	 lsttext_ong	     po	       str	 val
	 lstval	   lstvalpo  doan      pogan	 tenkhu
	 strso	   lstpo     p2	       en
	)
 (or ActDoc
     (setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (or *Model* (setq *Model* (vla-get-ModelSpace ActDoc)))
 (vla-StartUndoMark ActDoc)
 (SAVE_MODE)
 (setq	lstent	  (SS-entlst (ssget '((0 . "LWPOLYLINE,TEXT")
			      (8 . "vh,thoatnuoc,sttnut,sttkhu")
			     )
		     )
	  )
lstLWP_tn (filter lstent "LWPOLYLINE" "thoatnuoc")
lstLWP_vh (filter lstent "LWPOLYLINE" "vh")
lsttextt  (filter lstent "TEXT" "sttnut")
 )
 (setq	p1   (append (acet-list-remove-nth 2 (getvar "extmin")) (list 0.0))
rows (length lstLWP_tn)
 )
 (setq	tsi    (acet-dxf 40 (entget (nth 0 lsttextt)))
Tstyle (acet-dxf 7 (entget (nth 0 lsttextt)))
 )
 (setq oldtsi tsi)
 (setq	tsi (getreal
      (strcat "\nChon do cao text <" (rtos oldtsi 2 0) "> : ")
    )
 )
 (or tsi (setq tsi oldtsi))
;;;------------------
 (foreach entLWP2 lstLWP_vh
;;;    (redraw entLWP2 3)
   (setq lstpoCP (ACET-GEOM-VERTEX-LIST entLWP2))
   (if	(or (vlax-curve-isClosed entLWP2)
    (eq (car lstpoCP) (last lstpoCP))
)
     (progn
(setq ss3 (ssget "CP"
		 lstpoCP
		 '((0 . "TEXT") (8 . "sttkhu"))
	  )
)
(if ss3
  (progn
    (setq lstenttext (SS-entlst ss3))
    (setq lstLWP_vh_text
	   (cons (cons entLWP2 lstenttext) lstLWP_vh_text)
    )
  )
)
     )
   )
;;;    (redraw entLWP2 4)
 )
;;;---------------

 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)
   (progn
     (setq TblObj (vla-addtable
	     *Model*
	     (vlax-3d-point p1)
	     (1+ rows)
	     ;;the number of rows 
	     3
	     ;;the number of columns 
	     tsi
	     ;;the height of the rows
	     (* 6 tsi)
	     ;;the width of the columns 
	   )
     )
     (vla-UnMergeCells TblObj 0 0 0 2)
     (vla-MergeCells TblObj 0 0 1 2)
     (vla-put-vertcellmargin TblObj (* 0.5 tsi))
     (mapcar '(lambda (x) (vla-setTextHeight TblObj x tsi))
      (list acTitleRow acHeaderRow acDataRow)
     )
     (mapcar
'(lambda (x) (vla-setAlignment TblObj x acMiddleCenter))
(list acTitleRow acHeaderRow acDataRow)
     )
     (mapcar
'(lambda (x) (vla-SetTextStyle TblObj x Tstyle))
(list acTitleRow acHeaderRow acDataRow)
     )
     (vla-setText TblObj 0 0 "§O¹N èNG")
     (vla-setText TblObj 0 1 "TIÓU KHU")
     (vla-SetColumnWidth TblObj 0 (* 8.4 tsi))
     (setq nRow 1)

;;;  ===================;tung duong ong
     (foreach entLWP lstLWP_tn
(setq objLwp  (vlax-ename->vla-object entLWP)
      lstpoF (ACET-GEOM-VERTEX-LIST entLWP)
      len     (vla-get-Length objLwp)
      midpo   (vlax-curve-getPointAtDist objLwp (/ len 2))
      param   (vlax-curve-getParamAtPoint objLwp midpo)
      ang      (angle '(0 0 0) (vlax-curve-getFirstDeriv objLwp param))
      mfen1   (polar midpo (+ ang (/ pi 2)) 75)
      mfen2   (polar midpo (- ang (/ pi 2)) 75)
      ss      (ssget "F" lstpoF '((0 . "TEXT") (8 . "sttnut")))
      lstLWP2 (SS-entlst (ssget	"F"
				(list mfen1 mfen2)
				'((0 . "LWPOLYLINE") (8 . "vh"))
			 )
	      )
)
(if ss
  (progn
    (setq lsttext_ong (SS-entlst ss))
;;;    ==============;tung text chu dau ong sttnut
    (foreach ent lsttext_ong
      (redraw ent 3)
      (setq po	   (dxf 10 ent)
	    str	   (dxf 1 ent)
	    val	   (read str)
	    lstval (append (list str) lstval)
      )
      (redraw ent 4)
    )
    (setq doan (strcat (nth 1 lstval) "-" (nth 0 lstval)))
    (and doan (vla-setText TblObj nRow 0 doan))
    (setq nCol 1)
  )
)
;;;    =========================;tung duong bao / 2 
(foreach entLWP2 lstLWP2
  (setq	lstenttext
	 (acet-dxf entLWP2 lstLWP_vh_text)
	lstpo nil
	lstvalpo nil
  )
;;;      ====================;tung text trong duong bao
  (foreach ent lstenttext
    (setq po (dxf 10 ent))
    (if	(distof (dxf 1 ent))
      (setq strso (dxf 1 ent))
      (progn
	(setq str      (dxf 1 ent)
	      lstpo    (cons po lstpo)
	      lstvalpo (cons (cons po str) lstvalpo)
	)
      )
    )
  )
  (if lstvalpo
    (progn
      (setq pogan  (timgan midpo lstpo)
	    tenkhu (strcat strso (acet-dxf pogan lstvalpo))
      )
      (and tenkhu (vla-setText TblObj nRow nCol tenkhu))
      (setq nCol (1+ nCol))
    )
  )
)
(setq nRow (1+ nRow))
     )
   )					;END progn
 )					;END IF
 (vla-Update TblObj)
 (setq	en  (entlast)
ss (acet-list-to-ss (list en))
 )
 (setq
   p2 (acet-ss-drag-move ss p1 "\n<<< Place Table >>> ")
 )
 (vla-put-InsertionPoint TblObj (vlax-3d-point p2))
 (vla-Update TblObj)
 (vlax-release-object TblObj)
 (RESTORE)
 (vla-StartUndoMark ActDoc)
 (princ "\nThank you for use my lisp: svb.lsp!")
 (princ)
)

[Tue_NV 3.912]

Chào svba, A Thiep thấy có sự khác nhau về câu hỏi: lisp của anh hỏi: "Chon do cao text :"

Còn lisp svba chạy thì hỏi: "Chon do cao text : " là sao vậy sao kà!

Là vầy : svba nhấn nút Download lisp file :

-> Dòng của bác Thiep đẹp như vầy : (strcat "\nChon do cao text : ")

 

---> Lại trở thành như vầy đó : (strcat "\nChon do cao text : ")

 

Buồn như zầy đó :D

 

@svba : Hãy nhấn nút Reply bài viết của bác Thiep -> chép hết code về sử dụng, em nhé.

[svba1608 627]

Cảm ơn anh Thiệp và anh Tue_NV! Nhờ sự giúp đỡ của các anh, em đã hoàn thành được rồi.

Nay em lại có một việc khác muốn nhờ.

 

 

Như trên hình minh hoạ, em cần đánh dấu chiều chảy vào các ống của các lưu vực.

Ví dụ như ô số 23 và 32, cần vẽ các mũi tên hướng từ tâm ra phía đường ống cho toàn bộ các ô trong bản vẽ (để thể hiện chiều chảy của nước).

Nhờ các anh giúp đỡ! Em xin chân thành cảm ơn!

File minh hoạ

http://www.cadviet.com/upfiles/2/d_1.dwg

[Vu Dinh Tu 0]

Các bác cho em hỏi làm thế nào để lấy được tất cả các tên của layer trong một bản vẽ.

Em muốn dùng lisp để đặt net in theo layer cho tiện.

 

Thanks các bác,

[phamthanhbinh 3.146]

Các bác cho em hỏi làm thế nào để lấy được tất cả các tên của layer trong một bản vẽ.

Em muốn dùng lisp để đặt net in theo layer cho tiện.

 

Thanks các bác,

Chào bạn Vu Dinh Tu,

Lần sau bạn nên chịu khó tìm kiếm trên diễn đàn trước khi post yêu cầu của bạn, bạn nhé.

Đây là cái lisp đã được post lên khá lâu, mình quên mất tên tác giả, hình như của bác SSG hay Nguyenhoanh chi đó, bạn tham khảo nhé.

http://www.cadviet.com/upfiles/2/lapdslayer.lsp

 

Chúc bạn vui khi tham gia diễn đàn.

[kieumanh 140]

Các bác ơi! Tôi dùng lệnh leader để vẽ mũi tên (dim leader) mà không muốn có text kèm theo nên thao tác thường là:

- Le, pick 3 điểm trên màn hình, Enter, Enter, n, Enter.

Tôi muốn viết lisp để nhập lệnh "le" rồi pick 3 điểm có ngay kết quả mà thử mãi không được. (Trình lisp gà quá) Bác Hoành hay cao thủ nào giúp với.

[Tue_NV 3.912]

Các bác ơi! Tôi dùng lệnh leader để vẽ mũi tên (dim leader) mà không muốn có text kèm theo nên thao tác thường là:

- Le, pick 3 điểm trên màn hình, Enter, Enter, n, Enter.

Tôi muốn viết lisp để nhập lệnh "le" rồi pick 3 điểm có ngay kết quả mà thử mãi không được. (Trình lisp gà quá) Bác Hoành hay cao thủ nào giúp với.

Bạn thử cái này nhé :

(defun c:drl() (command "leader" pause pause pause "" "" "N") (princ))

[kieumanh 140]

Hải Phòng có đường Đà Nẵng, Đà Nẵng có đường Hải Phòng. Cám ơn bác nhé. A e nhiệt tình quá, mới hỏi hôm qua đã có bác giúp rồi. Đa tạ, đa tạ.

[missyoutd01 0]

Em đang cần đoạn lips hỗ trợ việc tạo các Line Type chuẩn cho từng khổ giấy A0, A1, A2, A3, A4. Ví dụ layer tim là đường đứt nét với khổ A0, sẽ khác với đường tim đứt nét ở khổ A4... Vậy cao thủ nào biết về lips lập hộ luôn cho em layer tim và layer khuất theo từng khổ giấy luôn, để em khỏi phải vào layer căn chỉnh, em cảm ơn nhiều :X

http://www.cadviet.com/upfiles/2/thiet_lap...g_kho_giay1.dwg

 

 

 

Tiện thể nhờ anh em giúp hộ mình lập lips làm ẩn blog này so với blog kia khi 2 blog trùng nhau, có bản vẽ ở dưới. Mong các bác giúp cho em một tay. Thanks các đại ka fát nữa hehhehe

http://www.cadviet.com/upfiles/2/doi_tuong...a_che_khuat.dwg

[Tue_NV 3.912]

.......

Tiện thể nhờ anh em giúp hộ mình lập lips làm ẩn blog này so với blog kia khi 2 blog trùng nhau, có bản vẽ ở dưới. Mong các bác giúp cho em một tay. Thanks các đại ka fát nữa hehhehe

http://www.cadviet.com/upfiles/2/doi_tuong...a_che_khuat.dwg

Có phải ý của bạn như thế này :

Kích vào Block đó -> Xuất hiện mũi tên tam giác trỏ xuống (ở phía trên). Kích vào mũi tên tam giác đó và chọn Nha hoặc mái nhà nhé.

File đây :

http://www.cadviet.com/upfiles/2/doi_tuong...a_che_khuat.rar

 

Bạn có thể xem cách tạo nó ở đây :

http://www.cadviet.com/forum/index.php?showtopic=2511

 

Lưu ý : CAD2007 trở lên thì sử dụng được chức năng này. CAD2005,CAD2006 chưa thử. CAD2004 trở xuống không có chức năng này.

[Ngolevietduc87 0]

Các bác có biết lisp nào cho phép đo khoảng cách từ tất cả các block trong bản vẽ đến 1 đường pline ,sau đó xuất ra file exel tọa độ của các block đó kèm theo khoảng cách đến đường pline không ạ?Hoặc cái gì tương tự thế cũng được.Dưới đây là file đính kèm

http://www.cadviet.com/upfiles/2/vidu_1.dwg

Mong được mọi người giúp đỡ!

[phamthanhbinh 3.146]

Các bác có biết lisp nào cho phép đo khoảng cách từ tất cả các block trong bản vẽ đến 1 đường pline ,sau đó xuất ra file exel tọa độ của các block đó kèm theo khoảng cách đến đường pline không ạ?Hoặc cái gì tương tự thế cũng được.Dưới đây là file đính kèm

http://www.cadviet.com/upfiles/2/vidu_1.dwg

Mong được mọi người giúp đỡ!

Chào bạn Ngolevietduc87,

Có phải bạn muốn đo khoảng cách từ điểm chèn của block tới đường line hay không???? Và tọa độ bạn nói là tọa độ của điểm chèn ????

Vì không mở được file của bạn nên chưa hiểu rõ điều bạn cần.( Mình xài Cad2004).

[missyoutd01 0]

Có phải ý của bạn như thế này :

Kích vào Block đó -> Xuất hiện mũi tên tam giác trỏ xuống (ở phía trên). Kích vào mũi tên tam giác đó và chọn Nha hoặc mái nhà nhé.

File đây :

http://www.cadviet.com/upfiles/2/doi_tuong...a_che_khuat.rar

Trước tiên mình chân thành cảm ơn bạn Tue_NV, nhưng ý mình không phải như bạn nghĩ, ý mình là: Mình đã có bản vẽ sẵn đó ( bản vẽ mình đã upload) bản vẽ đó do người khác lập nên, mình thấy trong bản vẽ đó có 2 đối tượng blog, 1 là blog Mặt Bằng và 1 là blog Mái. Mình thấy blog Mặt Bằng bị che bằng blog Mái, vậy người ta đã dùng lệnh gì để có thể che blog Mặt Bằng bằng blog mái được?! Hiện tại mình đang có 1 bản vẽ khác gồm, 1 blog Mặt Bằng và 1 là blog Mái và nhiệm vụ của mình là che blog Mặt bằng bằng blog Mái khi 2 blog đó trùng nhau! ( tức là blog này ẩn so với blog kia thì dung lệnh gì ? )

[Tue_NV 3.912]

Trước tiên mình chân thành cảm ơn bạn Tue_NV, nhưng ý mình không phải như bạn nghĩ, ý mình là: Mình đã có bản vẽ sẵn đó ( bản vẽ mình đã upload) bản vẽ đó do người khác lập nên, mình thấy trong bản vẽ đó có 2 đối tượng blog, 1 là blog Mặt Bằng và 1 là blog Mái. Mình thấy blog Mặt Bằng bị che bằng blog Mái, vậy người ta đã dùng lệnh gì để có thể che blog Mặt Bằng bằng blog mái được?! Hiện tại mình đang có 1 bản vẽ khác gồm, 1 blog Mặt Bằng và 1 là blog Mái và nhiệm vụ của mình là che blog Mặt bằng bằng blog Mái khi 2 blog đó trùng nhau! ( tức là blog này ẩn so với blog kia thì dung lệnh gì ? )

Có phải ý của bạn như thế này :

http://www.cadviet.com/upfiles/2/tue_nv.dwg

PS : Bạn ghi đúng chính tả nhé Block chứ không phải Blog

Đó là 1 Block chứ không phải là 2 Block như điều bạn nói.

 

@ bác PhamThanhBinh : Đó là 1 Block chứ không phải là 2 Block bác ạ

[phamthanhbinh 3.146]

Trước tiên mình chân thành cảm ơn bạn Tue_NV, nhưng ý mình không phải như bạn nghĩ, ý mình là: Mình đã có bản vẽ sẵn đó ( bản vẽ mình đã upload) bản vẽ đó do người khác lập nên, mình thấy trong bản vẽ đó có 2 đối tượng blog, 1 là blog Mặt Bằng và 1 là blog Mái. Mình thấy blog Mặt Bằng bị che bằng blog Mái, vậy người ta đã dùng lệnh gì để có thể che blog Mặt Bằng bằng blog mái được?! Hiện tại mình đang có 1 bản vẽ khác gồm, 1 blog Mặt Bằng và 1 là blog Mái và nhiệm vụ của mình là che blog Mặt bằng bằng blog Mái khi 2 blog đó trùng nhau! ( tức là blog này ẩn so với blog kia thì dung lệnh gì ? )

Chào bạn missyuotd01,

Bạn thử xài hai lệnh bring to front và send to back chưa nhỉ. Lệnh này dùng kết hợp với layer, nếu bạn cho hai cái block của bạn nằm trên hai layer khác nhau thì điều bạn muốn sẽ dễ dàng thực hiện.

Chúc bạn vui.

[Ngolevietduc87 0]

Chào bạn Ngolevietduc87,

Có phải bạn muốn đo khoảng cách từ điểm chèn của block tới đường line hay không???? Và tọa độ bạn nói là tọa độ của điểm chèn ????

Vì không mở được file của bạn nên chưa hiểu rõ điều bạn cần.( Mình xài Cad2004).

Cảm ơn bác PhamThanhBinh đã quan tâm!

Bác hiểu đúng ý em cần rồi,nhưng không phải là đường Line mà là Polyline (ở trong bản vẽ của em cũng là Polyline)

Sau đây em xin up lại file cad ver2004: http://www.cadviet.com/upfiles/2/vidu_2.dwg

Mong bác và các Pro khác giúp đỡ

Thanks!

[phamthanhbinh 3.146]

Cảm ơn bác PhamThanhBinh đã quan tâm!

Bác hiểu đúng ý em cần rồi,nhưng không phải là đường Line mà là Polyline (ở trong bản vẽ của em cũng là Polyline)

Sau đây em xin up lại file cad ver2004: http://www.cadviet.com/upfiles/2/vidu_2.dwg

Mong bác và các Pro khác giúp đỡ

Thanks!

Chào bạn Ngolevietduc87,

Bạn dùng thử cái lisp này và cho ý kiến nhé.

Bạn lưu ý rằng do bạn không nói rõ cái khoảng cách từ điểm chèn block tới đường polyline chuẩn bạn chọn như thế nào nên mình cứ hiểu đơn giản rằng đó là khoảng cách ngắn nhất tính từ điểm đó tới một điểm khác trên polyline. Nếu bạn không sử dụng theo định nghĩa này thì kết quả khoảng cách này sẽ sai đấy nhé.

Trong lisp này, yêu cầu bạn phải nhập đúng cái tên của block và tên layer chứa block. Nếu bạn nhập sai, lisp sẽ không chạy đâu.

Lisp này cũng mới dừng lại ở việc xuất ra bản vẽ cái bảng kết quả. Nếu bạn muốn xuất sang excel thì bạn cần thêm một đoạn code khác nữa.

Nó đây:

(defun c:lb1 ()
(vl-load-com)
(command "undo" "be")
(setq li1 (list)
blk (entsel "\n Hay chon block mau")
bln (cdr (assoc 2 (entget (car blk))))
lan (cdr (assoc 8 (entget (car blk))))
ss (ssget "x" (list ( cons 0 "INSERT") (cons 2 bln) (cons 8 lan)))
n (sslength ss)
i 0
)
(if (/= n nil)
(progn
(while ((setq li1 (append  li1 (list (cdr (assoc 10 (entget (ssname ss i))))))
i (1+ i))
)
)
)
li1
(setq en (car (entsel "\n Chon duong chuan"))
li2 (list)
ob (vlax-ename->vla-object en)
)
(foreach p li1
(setq p0 (vlax-curve-getClosestPointTo ob p acExtendNone) 
d (distance p p0)
li2 (append li2 (list d))
)
)
(setq pb (getpoint "\n Chon diem nhap bang ket qua")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\ Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
;;;;(command "text" pb h 0 "BANG KET QUA")
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
;;;(command "text" (list (car pb) (- (cadr pb) (* 1.5 h))) h 0 "STT")
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
;;;(command "text" (list (+ (car pb) k) (- (cadr pb) (* 1.5 h))) h 0 "X")
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Y")))
;;;(command "text" (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h))) h 0 "Y")
(entmake 
(list 
(cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Khoang cach")))
;;;(command "text" (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h))) h 0 "Khoang cach")
(setq a 0)
(while ((setq b (nth  a li1)
y (- (cadr pb) (* (+ 2 a) 1.5 h))
)
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1  (rtos (1+ a) 2 0))))
;;;(command "text" (list (car pb) y) h 0 (rtos (1+ a) 2 0))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car b ) 2 2))))
;;;(command "text" (list (+ (car pb) k) y) h 0 (rtos (car b ) 2 2))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr b ) 2 2))))
;;;(command "text" (list (+ (car pb) (* 2 k)) y) h 0 (rtos (cadr b ) 2 2))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (nth a li2) 2 2))))
;;;(command "text" (list (+ (car pb) (* 3 k)) y) h 0 (rtos (nth a li2) 2 2))
(setq a (1+ a))
) 
(command "undo" "e")
(princ)
)

 

Và đây là cái kết quả mà mình đã chạy với file bạn gửi:

http://www.cadviet.com/upfiles/2/lb1.jpg

 

Nếu có gì chưa hài lòng bạn hãy post lên nhé.

Chúc bạn vui.

 

Bài viết được chỉnh sửa bởi Phạm Thanh Bình theo sự góp ý của bác Tue_NV

[Tue_NV 3.912]

Chào bạn Ngolevietduc87,

Bạn dùng thử cái lisp này và cho ý kiến nhé.

Bạn lưu ý rằng do bạn không nói rõ cái khoảng cách từ điểm chèn block tới đường polyline chuẩn bạn chọn như thế nào nên mình cứ hiểu đơn giản rằng đó là khoảng cách ngắn nhất tính từ điểm đó tới một điểm khác trên polyline. Nếu bạn không sử dụng theo định nghĩa này thì kết quả khoảng cách này sẽ sai đấy nhé.

Trong lisp này, yêu cầu bạn phải nhập đúng cái tên của block và tên layer chứa block. Nếu bạn nhập sai, lisp sẽ không chạy đâu.

Lisp này cũng mới dừng lại ở việc xuất ra bản vẽ cái bảng kết quả. Nếu bạn muốn xuất sang excel thì bạn cần thêm một đoạn code khác nữa.

Nó đây:

(defun c:lb1 ()
(vl-load-com)
(command "undo" "be")
(setq li1 (list)
bln (getstring "\n Nhap ten block: ")
lan (getstring "\n Nhap ten layer: ")
ss (ssget "x" (list ( cons 0 "INSERT") (cons 2 bln) (cons 8 lan)))
n (sslength ss)
i 0
)
(if (/= n nil)
(progn
(while ((setq li1 (append  li1 (list (cdr (assoc 10 (entget (ssname ss i))))))
i (1+ i))
)
)
)
li1
(setq en (car (entsel "\n Chon duong chuan"))
li2 (list)
ob (vlax-ename->vla-object en)
)
(foreach p li1
(setq p0 (vlax-curve-getClosestPointTo ob p acExtendNone) 
d (distance p p0)
li2 (append li2 (list d))
)
)
(setq pb (getpoint "\n Chon diem nhap bang ket qua")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\ Nhap do rong cot: ")
)
(command "text" pb h 0 "BANG KET QUA")
(command "text" (list (car pb) (- (cadr pb) (* 1.5 h))) h 0 "STT")
(command "text" (list (+ (car pb) k) (- (cadr pb) (* 1.5 h))) h 0 "X")
(command "text" (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h))) h 0 "Y")
(command "text" (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h))) h 0 "Khoang cach")
(setq a 0)
(while ((setq b (nth  a li1)
y (- (cadr pb) (* (+ 2 a) 1.5 h))
)
(command "text" (list (car pb) y) h 0 (rtos (1+ a) 2 0))
(command "text" (list (+ (car pb) k) y) h 0 (rtos (car b ) 2 2))
(command "text" (list (+ (car pb) (* 2 k)) y) h 0 (rtos (cadr b ) 2 2))
(command "text" (list (+ (car pb) (* 3 k)) y) h 0 (rtos (nth a li2) 2 2))
(setq a (1+ a))
) 
(command "undo" "e")
(princ)
)

 

Và đây là cái kết quả mà mình đã chạy với file bạn gửi:

http://www.cadviet.com/upfiles/2/lb1.jpg

 

Nếu có gì chưa hài lòng bạn hãy post lên nhé.

Chúc bạn vui.

Tue_NV có mấy lời góp ý với Lisp của bác PhamThanhBinh :

1. Kết quả Lisp sẽ chạy sai khi chiều cao của style hiện hành khác 0 trong hộp thoại Style. Muốn Lisp chạy đúng cho mọi trường hợp thì phải thiết lập chiều cao của style hiện hành bằng 0

Cách khác hay hơn là bác thiết lập việc ghi chữ bằng hàm entmake

 

2. Việc sử dụng hàm (ssget "X") khiến cho toàn bộ Block trên bản vẽ mang tên bln "đi vào" bảng thống kê. Có thể bỏ chữ "X" trong hàm (ssget)

 

3. Thay vì "nhập đúng cái tên của block và tên layer chứa block" -> bác nên cho mã lệnh pick chọn 1 block mẫu -> ta lấy tên Block chọn theo Block mẫu này

Hơn nữa, việc dùng hàm (getstring "\n Nhap ten block: ") là chưa đúng lắm. Vì tên block có thể có khoảng trắng nhưng nếu bác dùng hàm như trên thì nhập không có khoảng trắng bác ạ.

 

Vài lời góp ý. Chúc bác cuối tuần vui vẻ.

 

-Nhìn vào hình vẽ mà bác đã upload cho bạn Ngolevietduc87 thì rõ ràng là bác đã cài đặt DWGgateway thì sao lại không mở được file của các Version CAD nhỉ?

[missyoutd01 0]

Cảm ơn bạn Tue_Vn và bạn Thanhbinh, bạn Tue đã làm đúng theo ý mình rồi, vậy bạn có thể chỉ cho mình cách nào để làm được như thế không? còn theo cách của Thanhbinh thì mình đã thử rồi ( mình dùng Draw Order rồi nhưng vẫn không được. Xin các cao thủ chỉ giáo giúp. Thanks

[phamthanhbinh 3.146]

Tue_NV có mấy lời góp ý với Lisp của bác PhamThanhBinh :

1. Kết quả Lisp sẽ chạy sai khi chiều cao của style hiện hành khác 0 trong hộp thoại Style. Muốn Lisp chạy đúng cho mọi trường hợp thì phải thiết lập chiều cao của style hiện hành bằng 0

Cách khác hay hơn là bác thiết lập việc ghi chữ bằng hàm entmake

 

2. Việc sử dụng hàm (ssget "X") khiến cho toàn bộ Block trên bản vẽ mang tên bln "đi vào" bảng thống kê. Có thể bỏ chữ "X" trong hàm (ssget)

 

3. Thay vì "nhập đúng cái tên của block và tên layer chứa block" -> bác nên cho mã lệnh pick chọn 1 block mẫu -> ta lấy tên Block chọn theo Block mẫu này

Hơn nữa, việc dùng hàm (getstring "\n Nhap ten block: ") là chưa đúng lắm. Vì tên block có thể có khoảng trắng nhưng nếu bác dùng hàm như trên thì nhập không có khoảng trắng bác ạ.

 

Vài lời góp ý. Chúc bác cuối tuần vui vẻ.

 

-Nhìn vào hình vẽ mà bác đã upload cho bạn Ngolevietduc87 thì rõ ràng là bác đã cài đặt DWGgateway thì sao lại không mở được file của các Version CAD nhỉ?

Chào bác Tue_NV,

Rất cám ơn những sự đóng góp của bác. Mình sẽ sửa lại. Riêng việc bỏ tham số "X" của hàm ssget thì mình thấy không cần thiết do bạn Ngolevietduc87 yêu cầu là "tất cả các block trong bản vẽ" . Nếu bỏ tham số này đi thì user sẽ phải chọn các block theo các phương pháp lựa chọn của CAD.

Cái vụ DWGgateway mình cũng chả biết tại sao???Cài nó khá lâu rồi nhưng hiệu quả thì chả thấy gì. Khổ thế. Nếu bác biết thì chỉ giùm mình với.

[sucuph 1]

Em muốn nhờ các bác hộ em 1 cái lisp mà khi pick vào 1 đường pline thì sẽ hiện tất cả toạ độ các điểm lên bản vẽ, đồng thời xuất ra 1 file txt. Mong các bác giúp cho, thanks!!!

[phamthanhbinh 3.146]

Sau khi tham khảo các bài hướng dẫn của bác SSG, mình thử liều viết bổ sung vào cái lisp lb1.lsp viết cho bạn Ngolevietduc87 để có thể xuất dữ liệu vào một file excel. Vì đây là thử nghiệm lần đầu tiên nên rất mong các bác xem qua và góp ý nhé. Nó đây ạ:

(defun c:lb1 ()
(vl-load-com)
(defun GetExcel (ExcelFile$ SheetName$ MaxRange$ / Column# ColumnRow@ Data@ ExcelRange^
ExcelValue ExcelValue ExcelVariant^ MaxColumn# MaxRow# Range$ Row# Worksheet)
(if (= (type ExcelFile$) 'STR)
(if (not (findfile ExcelFile$))
(progn
(alert (strcat "Excel file " ExcelFile$ " not found."))
(exit)
);progn
);if
(progn
(alert "Excel file not specified.")
(exit)
);progn
);if
(gc)
(if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
(progn
(alert "Close all Excel spreadsheets to continue!")
(vlax-release-object *ExcelApp%)(gc)
);progn
);if
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
(if SheetName$
(vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
(if (= (vlax-get-property Worksheet "Name") SheetName$)
(vlax-invoke-method Worksheet "Activate")
);if
);vlax-for
);if
(setq ColumnRow@ (ColumnRow MaxRange$))
(setq MaxColumn# (nth 0 ColumnRow@))
(setq MaxRow# (nth 1 ColumnRow@))
(setq *ExcelData@ nil)
(setq Row# 1)
(repeat MaxRow#
(setq Data@ nil)
(setq Column# 1)
(repeat MaxColumn#
(setq Range$ (strcat (Number2Alpha Column#)(itoa Row#)))
(setq ExcelRange^ (vlax-get-property *ExcelApp% "Range" Range$))
(setq ExcelVariant^ (vlax-get-property ExcelRange^ 'Value))
(setq ExcelValue (vlax-variant-value ExcelVariant^))
(setq ExcelValue
(cond
((= (type ExcelValue) 'INT) (itoa ExcelValue))
((= (type ExcelValue) 'REAL) (rtosr ExcelValue))
((= (type ExcelValue) 'STR) (vl-string-trim " " ExcelValue))
((/= (type ExcelValue) 'STR) "")
);cond
);setq
(setq Data@ (append Data@ (list ExcelValue)))
(setq Column# (1+ Column#))
);repeat
(setq *ExcelData@ (append *ExcelData@ (list Data@)))
(setq Row# (1+ Row#))
);repeat
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
(vlax-invoke-method *ExcelApp% 'Quit)
(vlax-release-object *ExcelApp%)(gc)
(setq *ExcelApp% nil)
*ExcelData@
);defun GetExcel
;-------------------------------------------------------------------------------
; GetCell - Returns the cell value from the *ExcelData@ list
; Arguments: 1
; Cell$ = Cell ID
; Syntax example: (GetCell "E19") = value of cell E19
;-------------------------------------------------------------------------------
(defun GetCell (Cell$ / Column# ColumnRow@ Return Row#)
(setq ColumnRow@ (ColumnRow Cell$))
(setq Column# (1- (nth 0 ColumnRow@)))
(setq Row# (1- (nth 1 ColumnRow@)))
(setq Return "")
(if *ExcelData@
(if (and (>= (length *ExcelData@) Row#)(>= (length (nth 0 *ExcelData@)) Column#))
(setq Return (nth Column# (nth Row# *ExcelData@)))
);if
);if
Return
);defun GetCell
;-------------------------------------------------------------------------------
; OpenExcel - Opens an Excel spreadsheet
; Arguments: 3
; ExcelFile$ = Excel filename or nil for new spreadsheet
; SheetName$ = Sheet name or nil for not specified
; Visible = t for visible or nil for hidden
; Syntax examples:
; (OpenExcel "C:\\Temp\\Temp.xls" "Sheet2" t) = Opens C:\Temp\Temp.xls on Sheet2 as visible session
; (OpenExcel "C:\\Temp\\Temp.xls" nil nil) = Opens C:\Temp\Temp.xls on current sheet as hidden session
; (OpenExcel nil "Parts List" nil) = Opens a new spreadsheet and creates a Part List sheet as hidden 

session
;-------------------------------------------------------------------------------
(defun OpenExcel (ExcelFile$ SheetName$ Visible / Sheet$ Sheets@ Worksheet)
(if (= (type ExcelFile$) 'STR)
(if (findfile ExcelFile$)
(setq *ExcelFile$ ExcelFile$)
(progn
(alert (strcat "Excel file " ExcelFile$ " not found."))
(exit)
);progn
);if
(setq *ExcelFile$ "")
);if
(gc)
(if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
(progn
(alert "Close all Excel spreadsheets to continue!")
(vlax-release-object *ExcelApp%)(gc)
);progn
);if
(setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
(if ExcelFile$
(if (findfile ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
);if
(vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Add)
);if
(if Visible
(vla-put-visible *ExcelApp% :vlax-true)
);if
(if (= (type SheetName$) 'STR)
(progn
(vlax-for Sheet$ (vlax-get-property *ExcelApp% "Sheets")
(setq Sheets@ (append Sheets@ (list (vlax-get-property Sheet$ "Name"))))
);vlax-for
(if (member SheetName$ Sheets@)
(vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
(if (= (vlax-get-property Worksheet "Name") SheetName$)
(vlax-invoke-method Worksheet "Activate")
);if
);vlax-for
(vlax-put-property (vlax-invoke-method (vlax-get-property *ExcelApp% "Sheets") "Add") "Name" SheetName$)
);if
);progn
);if
(princ)
);defun OpenExcel
;-------------------------------------------------------------------------------
; PutCell - Put values into Excel cells
; Arguments: 2
; StartCell$ = Starting Cell ID
; Data@ = Value or list of values
; Syntax examples:
; (PutCell "A1" "PART NUMBER") = Puts PART NUMBER in cell A1
; (PutCell "B3" '("Dim" 7.5 "9.75")) = Starting with cell B3 put Dim, 7.5, and 9.75 across
;-------------------------------------------------------------------------------
(defun PutCell (StartCell$ Data@ / Cell$ Column# ExcelRange Row#)
(if (= (type Data@) 'STR)
(setq Data@ (list Data@))
)
(setq ExcelRange (vlax-get-property *ExcelApp% "Cells"))
(if (Cell-p StartCell$)
(setq Column# (car (ColumnRow StartCell$))
Row# (cadr (ColumnRow StartCell$))
);setq
(if (vl-catch-all-error-p
(setq Cell$ (vl-catch-all-apply 'vlax-get-property
(list (vlax-get-property *ExcelApp% "ActiveSheet") "Range" StartCell$))
);setq
);vl-catch-all-error-p
(alert (strcat "The cell ID \"" StartCell$ "\" is invalid."))
(setq Column# (vlax-get-property Cell$ "Column")
Row# (vlax-get-property Cell$ "Row")
);setq
);if
);if
(if (and Column# Row#)
(foreach Item Data@
(vlax-put-property ExcelRange "Item" Row# Column# (vl-princ-to-string Item))
(setq Column# (1+ Column#))
);foreach
);if
(princ)
);defun PutCell
;-------------------------------------------------------------------------------
; CloseExcel - Closes Excel spreadsheet
; Arguments: 1
; ExcelFile$ = Excel saveas filename or nil to close without saving
; Syntax examples:
; (CloseExcel "C:\\Temp\\Temp.xls") = Saveas C:\Temp\Temp.xls and close
; (CloseExcel nil) = Close without saving
;-------------------------------------------------------------------------------
(defun CloseExcel (ExcelFile$ / Saveas)
(if ExcelFile$
(if (= (strcase ExcelFile$) (strcase *ExcelFile$))
(if (findfile ExcelFile$)
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") "Save")
(setq Saveas t)
);if
(if (findfile ExcelFile$)
(progn
(vl-file-delete (findfile ExcelFile$))
(setq Saveas t)
);progn
(setq Saveas t)
);if
);if
);if
(if Saveas
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook")
"SaveAs" ExcelFile$ -4143 "" "" :vlax-false :vlax-false nil
);vlax-invoke-method
);if
(vlax-invoke-method (vlax-get-property *ExcelApp% "ActiveWorkbook") 'Close :vlax-False)
(vlax-invoke-method *ExcelApp% 'Quit)
(vlax-release-object *ExcelApp%)(gc)
(setq *ExcelApp% nil *ExcelFile$ nil)
(princ)
);defun CloseExcel
;-------------------------------------------------------------------------------
; ColumnRow - Returns a list of the Column and Row number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Cell$ = Cell ID
; Syntax example: (ColumnRow "ABC987") = '(731 987)
;-------------------------------------------------------------------------------
(defun ColumnRow (Cell$ / Column$ Char$ Row#)
(setq Column$ "")
(while ((setq Column$ (strcat Column$ Char$)
Cell$ (substr Cell$ 2)
);setq
);while
(if (and (/= Column$ "") (numberp (setq Row# (read Cell$))))
(list (Alpha2Number Column$) Row#)
'(1 1);default to "A1" if there's a problem
);if
);defun ColumnRow
;-------------------------------------------------------------------------------
; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
(if (= 0 (setq Num# (strlen Str$)))
0
(+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
(Alpha2Number (substr Str$ 2))
);+
);if
);defun Alpha2Number
;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
(defun Number2Alpha (Num# / Val#)
(if ((chr (+ 64 Num#))
(if (= 0 (setq Val# (rem Num# 26)))
(strcat (Number2Alpha (1- (/ Num# 26))) "Z")
(strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
);if
);if
);defun Number2Alpha
;-------------------------------------------------------------------------------
; Cell-p - Evaluates if the argument Cell$ is a valid cell ID
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
; Cell$ = String of the cell ID to evaluate
; Syntax examples: (Cell-p "B12") = t, (Cell-p "BT") = nil
;-------------------------------------------------------------------------------
(defun Cell-p (Cell$)
(and (= (type Cell$) 'STR)
(or (= (strcase Cell$) "A1")
(not (equal (ColumnRow Cell$) '(1 1)))
);or
);and
);defun Cell-p
;-------------------------------------------------------------------------------
; Row+n - Returns the cell ID located a number of rows from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
; Cell$ = Starting cell ID
; Num# = Number of rows from cell
; Syntax examples: (Row+n "B12" 3) = "B15", (Row+n "B12" -3) = "B9"
;-------------------------------------------------------------------------------
(defun Row+n (Cell$ Num#)
(setq Cell$ (ColumnRow Cell$))
(strcat (Number2Alpha (car Cell$)) (itoa (max 1 (+ (cadr Cell$) Num#))))
);defun Row+n
;-------------------------------------------------------------------------------
; Column+n - Returns the cell ID located a number of columns from cell
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 2
; Cell$ = Starting cell ID
; Num# = Number of columns from cell
; Syntax examples: (Column+n "B12" 3) = "E12", (Column+n "B12" -1) = "A12"
;-------------------------------------------------------------------------------
(defun Column+n (Cell$ Num#)
(setq Cell$ (ColumnRow Cell$))
(strcat (Number2Alpha (max 1 (+ (car Cell$) Num#))) (itoa (cadr Cell$)))
);defun Column+n
;-------------------------------------------------------------------------------
; rtosr - Used to change a real number into a short real number string
; stripping off all trailing 0's.
; Arguments: 1
; RealNum~ = Real number to convert to a short string real number
; Returns: ShortReal$ the short string real number value of the real number.
;-------------------------------------------------------------------------------
(defun rtosr (RealNum~ / DimZin# ShortReal$)
(setq DimZin# (getvar "DIMZIN"))
(setvar "DIMZIN" 8)
(setq ShortReal$ (rtos RealNum~ 2 8))
(setvar "DIMZIN" DimZin#)
ShortReal$
);defun rtosr
;-------------------------------------------------------------------------------
(princ);End of GetExcel.lsp
;--------------------------------------------------------------------------------
(command "undo" "be")
(setq li1 (list)
blk (entsel "\n Hay chon block mau")
bln (cdr (assoc 2 (entget (car blk))))
lan (cdr (assoc 8 (entget (car blk))))
ss (ssget "x" (list ( cons 0 "INSERT") (cons 2 bln) (cons 8 lan)))
n (sslength ss)
i 0
)
(if (/= n nil)
(progn
(while ((setq li1 (append  li1 (list (cdr (assoc 10 (entget (ssname ss i))))))
i (1+ i))
)
)
)
li1
(setq en (car (entsel "\n Chon duong chuan"))
li2 (list)
ob (vlax-ename->vla-object en)
)
(foreach p li1
(setq p0 (vlax-curve-getClosestPointTo ob p acExtendNone) 
d (distance p p0)
li2 (append li2 (list d))
)
)
(setq pb (getpoint "\n Chon diem nhap bang ket qua")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\ Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
;;;;(command "text" pb h 0 "BANG KET QUA")
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
;;;(command "text" (list (car pb) (- (cadr pb) (* 1.5 h))) h 0 "STT")
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
;;;(command "text" (list (+ (car pb) k) (- (cadr pb) (* 1.5 h))) h 0 "X")
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Y")))
;;;(command "text" (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h))) h 0 "Y")
(entmake 
(list 
(cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Khoang cach")))
;;;(command "text" (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h))) h 0 "Khoang cach")
(setq fn (getfiled "Select Excel File" "" "xls" 0))
(openexcel fn nil T)
(putcell "A1" (list "BANG KET QUA"))
(putcell "A2" (list "STT" "X" "Y" "Khoang cach"))
(setq a 0)
(while ((setq b (nth  a li1)
y (- (cadr pb) (* (+ 2 a) 1.5 h))
)
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1  (rtos (1+ a) 2 0))))
;;;(command "text" (list (car pb) y) h 0 (rtos (1+ a) 2 0))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car b ) 2 2))))
;;;(command "text" (list (+ (car pb) k) y) h 0 (rtos (car b ) 2 2))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr b ) 2 2))))
;;;(command "text" (list (+ (car pb) (* 2 k)) y) h 0 (rtos (cadr b ) 2 2))
(entmake
(list 
(cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (nth a li2) 2 2))))
;;;(command "text" (list (+ (car pb) (* 3 k)) y) h 0 (rtos (nth a li2) 2 2))
(putcell (strcat "A" (rtos (+ 3 a) 2 0)) 
(list (rtos (1+ a) 2 0) (rtos (car b ) 2 2) (rtos (cadr b ) 2 2) (rtos (nth a li2) 2 2))) 
(setq a (1+ a))
) 
(command "undo" "e")
(princ)
)

 

Lưu ý khi sử dụng: Phải tạo trước một file excel trống với tên tùy ý rồi thoát khỏi Excel. Khi chạy lisp sẽ hiển thị bảng lựa chọn file để mở, browse dến tên file vừa lập và clickOk

Lisp sẽ tự động lập bảng kết quả cả trên bản vẽ và cả trên sheet hiện hành của file excel.

[phamthanhbinh 3.146]

Em muốn nhờ các bác hộ em 1 cái lisp mà khi pick vào 1 đường pline thì sẽ hiện tất cả toạ độ các điểm lên bản vẽ, đồng thời xuất ra 1 file txt. Mong các bác giúp cho, thanks!!!

Hề hề hề, chào bạn sucuph,

Bạn phải cho biết rõ cái pline của bạn là "LWPOLYLINE" hay "POLYLINE" thì mới viết lisp được bạn nhé.

Bởi vì mỗi loại đối tượng sẽ có một phương pháp riêng để lấy tọa độ các đỉnh bạn ạ.

Hề hề hề, hoặc là bạn gửi một cái bản vẽ mẫu thể hiện các yêu cầu của bạn. Nhớ gửi bản vẽ ở dạng CAD2000 hay CAD2004 bạn nhé.

[phamthanhbinh 3.146]

Em muốn nhờ các bác hộ em 1 cái lisp mà khi pick vào 1 đường pline thì sẽ hiện tất cả toạ độ các điểm lên bản vẽ, đồng thời xuất ra 1 file txt. Mong các bác giúp cho, thanks!!!

Chào bạn Sucuph,

Bạn xài thử lisp này xem sao nhé. Mình chạy thử với LWPOLYLINE thì Ok, nhưng chưa thử với POLYLINE.

(defun c:lb2 ()
(vl-load-com)
(command "undo" "be")
(setq en (entsel "\n Chon pline ")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 0
li1 (list)
)
(setq pb (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\n Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Y")))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Z")))
(while ((setq p (vlax-curve-getPointAtParam ob i) 
li1 (append li1 (list p))
y (- (cadr pb) (* (+ 2 i) 1.5 h))
)
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0) 
(cons 1 (strcat (rtos (car p) 2 2) " " (rtos (cadr p) 2 2) " " (rtos (caddr p) 2 2)))))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1  (rtos (1+ i) 2 0))))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car p ) 2 2))))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr p ) 2 2))))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (caddr p) 2 2))))
(setq i (1+ i))
)
(command "undo" "e")
(princ)
)

 

Nếu có gì chưa ổn hãy post lên nhé. Hề hề hề