Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
daulau00

Lisp rải taluy trên đường cong

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

Help me. Đây là Lisp dùng để rãi taluy của đường. Nó rất tiện lợi cho việc thể hiện mái dốc của đường đào hoặc đắp, nhưng có một khó khăn với tôi đó là nó chỉ rãi được trên đường thẳng và trên đường pline và cung tròn còn trên đường spline thì bó tay.

Xin các Bác chỉnh sửa dùng cho với. Cám ơn trước nghe.

TL1: dùng để rãi trên đường thẳng và pline.

TL2: dùng để rãi trên cung tròn.

http://www.cadviet.com/upfiles/TALUY.lsp

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
Help me. Đây là Lisp dùng để rãi taluy của đường. Nó rất tiện lợi cho việc thể hiện mái dốc của đường đào hoặc đắp, nhưng có một khó khăn với tôi đó là nó chỉ rãi được trên đường thẳng và trên đường pline và cung tròn còn trên đường spline thì bó tay.

Xin các Bác chỉnh sửa dùng cho với. Cám ơn trước nghe.

TL1: dùng để rãi trên đường thẳng và pline.

TL2: dùng để rãi trên cung tròn.

http://www.cadviet.com/upfiles/TALUY.lsp

 

Cái này dựa vào việc tích toán các vị trí (point) để vẽ từng nét Taluy. Nó bị hạn chế tại các đối tượng có hình dạng xác định như LINE, ARC. Còn đối với các đối tượng khó xác định hình dạng như SPLINE thì bó tay.

Có cách đơn giản là bạn dùng block với mesuare. Như vậy cũng vẽ được taluy

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à lisp tôi sưu tầm và chỉnh sửa lại chút ít, có thể rải taluy cho các loại line, pline, spline, arc, circle ...

(Mới dừng ở việc vẽ taluy cho 1 đường, phần vẽ mái taluy giữa 2 đường tôi chưa sửa xong)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;vtl;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl ()
 (if (/= scale nil)
   (progn
     (setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
     (if (not (setq scaletmp (getint thongbao)))
(setq scaletmp scale)
     )
   )
   (progn
     (setq thongbao "Ty le ban ve ? <1/1000>:")
     (if (not (setq scaletmp (getint thongbao)))
(setq scaletmp 1000)
     )
   )
 )

 (setq scale scaletmp)

 (setq Defaultdist (* (* scale 2) 0.002))
 (if (setq tg (getreal	(strcat	"\nKhoang cach ky hieu ta luy <"
			(rtos Defaultdist 2 2)
			">:"
		)
       )
     )
   (setq Defaultdist tg)
 )

 (setq	chieutaluy1
 1
sodoan 0
 )
)

(defun nsl1 ()

 (setq
   ktdoantaluy1 2
   tg		 (getreal (strcat "\nChieu dai doan ngan<"
			  (rtos ktdoantaluy1 2 2)
			  ">:"
		  )
	 )
 )
 (if tg
   (setq ktdoantaluy1 tg)
 )
 (setq
   ktdoantaluy2 6
   tg		 (getreal (strcat "\nChieu dai doan dai<"
			  (rtos ktdoantaluy2 2 2)
			  ">:"
		  )
	 )
 )
 (if tg
   (setq ktdoantaluy2 tg)
 )
 (setq
   khoangcachtl 2
   tg		 (getreal (strcat "\nKhoang cach giua cac doan<"
			  (rtos khoangcachtl 2 2)
			  ">:"
		  )
	 )
 )
 (if tg
   (setq khoangcachtl tg)
 )
 (setq
   sodoanngan 3
   tg	       (getint (strcat "\nSo doan ngan trong 1 doan dai<"
		       (rtos sodoanngan 2 0)
		       ">:"
	       )
       )
 )
 (if tg
   (setq sodoanngan tg)
 )

)


(Defun PlMake (Plist)			;  Create polyline entities
 (entmake '((0 . "POLYLINE")))
 (setq	n  (length Plist)
ic 0
 )
 (while (< ic n)
   (entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
   (setq ic (1+ ic)
   )
 )
 (entmake '((0 . "SEQEND")))

)


;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
 (setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
 (setq ketthuc 1)
 (if (< sodoan sodoanngan)
   (progn
     (setq ktdoantaluy ktdoantaluy1)
     (setq sodoan (1+ sodoan))
   )
   (progn
     (setq ktdoantaluy ktdoantaluy2)
     (setq sodoan 0)
   )
 )
 (setq p2 (polar p1 pvt ktdoantaluy))
 (plmake (list p1 p2))
 (setq dem (1+ dem))
)

(Defun xddsd (com epl kc / e0 e p dsd)
 (setq e0 (entlast))
 (while e0
   (setq e e0)
   (setq e0 (entnext e0))
 )
 (command com epl kc)
 (setq e (entnext e))
 (while e
   (setq p (cdr (assoc 10 (entget e))))
   (if	p
     (setq dsd (cons p dsd))
   )
   (setq e (entnext e))
 )
 (command "_.Undo" 1)
 (setq dsd dsd)
)
				; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
 (setq dem 0)
 (setq e (entget (car ep)))
 (if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
  (= (cdr (assoc 0 e)) "POLYLINE")
  (= (cdr (assoc 0 e)) "SPLINE")
  (= (cdr (assoc 0 e)) "LINE")
  (= (cdr (assoc 0 e)) "ARC")
  (= (cdr (assoc 0 e)) "CIRCLE")
     )

   (setq ketthuc 1)
   (prompt "\nDoi tuong duoc chon khong hop le")
 )
 (if ketthuc
   (progn
     (setq thutu 0)
     (setq dsd (xddsd "_.Measure" ep khoangcachtl))
     (setq p1 (car dsd))
     (repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
     )
   )
 )
 (setq dem dem)
)

;;;==================================================
(Defun C:vtl1 (/ ep chon lai solan chon)

 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (command "undo" "g")
 (nsl)

 (setq ep 1)
 (while ep
   (setq solan	0
  chieutaluy 1
   )
   (setq ep (entsel "\nChon doi tuong ve ta luy..."))

   (if	ep
     (progn
(nsl1)
(setq solan (vetaluy ep))
(initget "Undo Change")
(while
  (setq chon (getkword "Undo/Change <enter for exit>: "))


   (if (= chon "Undo")
     (command "_.Undo" solan)
   )
   (if (= chon "Change")
     (progn
       (nsl1)

       (setq chieutaluy -1)
       (command "_.Undo" solan)
       (setq solan (vetaluy ep))

     )
   )

  (initget "Undo Change")
)

     )
   )
 )
 (command "undo" "e")
)

  • Vote tăng 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
Đây là lisp tôi sưu tầm và chỉnh sửa lại chút ít, có thể rải taluy cho các loại line, pline, spline, arc, circle ...

(Mới dừng ở việc vẽ taluy cho 1 đường, phần vẽ mái taluy giữa 2 đường tôi chưa sửa xong)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;vtl;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl ()
 (if (/= scale nil)
   (progn
     (setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
     (if (not (setq scaletmp (getint thongbao)))
(setq scaletmp scale)
     )
   )
   (progn
     (setq thongbao "Ty le ban ve ? <1/1000>:")
     (if (not (setq scaletmp (getint thongbao)))
(setq scaletmp 1000)
     )
   )
 )

 (setq scale scaletmp)

 (setq Defaultdist (* (* scale 2) 0.002))
 (if (setq tg (getreal	(strcat	"\nKhoang cach ky hieu ta luy <"
			(rtos Defaultdist 2 2)
			">:"
		)
       )
     )
   (setq Defaultdist tg)
 )

 (setq	chieutaluy1
 1
sodoan 0
 )
)

(defun nsl1 ()

 (setq
   ktdoantaluy1 2
   tg		 (getreal (strcat "\nChieu dai doan ngan<"
			  (rtos ktdoantaluy1 2 2)
			  ">:"
		  )
	 )
 )
 (if tg
   (setq ktdoantaluy1 tg)
 )
 (setq
   ktdoantaluy2 6
   tg		 (getreal (strcat "\nChieu dai doan dai<"
			  (rtos ktdoantaluy2 2 2)
			  ">:"
		  )
	 )
 )
 (if tg
   (setq ktdoantaluy2 tg)
 )
 (setq
   khoangcachtl 2
   tg		 (getreal (strcat "\nKhoang cach giua cac doan<"
			  (rtos khoangcachtl 2 2)
			  ">:"
		  )
	 )
 )
 (if tg
   (setq khoangcachtl tg)
 )
 (setq
   sodoanngan 3
   tg	       (getint (strcat "\nSo doan ngan trong 1 doan dai<"
		       (rtos sodoanngan 2 0)
		       ">:"
	       )
       )
 )
 (if tg
   (setq sodoanngan tg)
 )

)


(Defun PlMake (Plist)			;  Create polyline entities
 (entmake '((0 . "POLYLINE")))
 (setq	n  (length Plist)
ic 0
 )
 (while (< ic n)
   (entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
   (setq ic (1+ ic)
   )
 )
 (entmake '((0 . "SEQEND")))

)


;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
 (setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
 (setq ketthuc 1)
 (if (< sodoan sodoanngan)
   (progn
     (setq ktdoantaluy ktdoantaluy1)
     (setq sodoan (1+ sodoan))
   )
   (progn
     (setq ktdoantaluy ktdoantaluy2)
     (setq sodoan 0)
   )
 )
 (setq p2 (polar p1 pvt ktdoantaluy))
 (plmake (list p1 p2))
 (setq dem (1+ dem))
)

(Defun xddsd (com epl kc / e0 e p dsd)
 (setq e0 (entlast))
 (while e0
   (setq e e0)
   (setq e0 (entnext e0))
 )
 (command com epl kc)
 (setq e (entnext e))
 (while e
   (setq p (cdr (assoc 10 (entget e))))
   (if	p
     (setq dsd (cons p dsd))
   )
   (setq e (entnext e))
 )
 (command "_.Undo" 1)
 (setq dsd dsd)
)
				; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
 (setq dem 0)
 (setq e (entget (car ep)))
 (if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
  (= (cdr (assoc 0 e)) "POLYLINE")
  (= (cdr (assoc 0 e)) "SPLINE")
  (= (cdr (assoc 0 e)) "LINE")
  (= (cdr (assoc 0 e)) "ARC")
  (= (cdr (assoc 0 e)) "CIRCLE")
     )

   (setq ketthuc 1)
   (prompt "\nDoi tuong duoc chon khong hop le")
 )
 (if ketthuc
   (progn
     (setq thutu 0)
     (setq dsd (xddsd "_.Measure" ep khoangcachtl))
     (setq p1 (car dsd))
     (repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
     )
   )
 )
 (setq dem dem)
)

;;;==================================================
(Defun C:vtl1 (/ ep chon lai solan chon)

 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (command "undo" "g")
 (nsl)

 (setq ep 1)
 (while ep
   (setq solan	0
  chieutaluy 1
   )
   (setq ep (entsel "\nChon doi tuong ve ta luy..."))

   (if	ep
     (progn
(nsl1)
(setq solan (vetaluy ep))
(initget "Undo Change")
(while
  (setq chon (getkword "Undo/Change <enter for exit>: "))


   (if (= chon "Undo")
     (command "_.Undo" solan)
   )
   (if (= chon "Change")
     (progn
       (nsl1)

       (setq chieutaluy -1)
       (command "_.Undo" solan)
       (setq solan (vetaluy ep))

     )
   )

  (initget "Undo Change")
)

     )
   )
 )
 (command "undo" "e")
)

Lisp này khá tốt, chi cần sửa tay một tẹo là rải taluy cho 2 đường ngon ơ. Chỉ có điều nhập " khoảng cách ký hiệu taluy" để làm gì hả bác xìnâu? Và ấn Enter là tiếp tục chứ không phải thoát. Theo em để rải đẹp thì cần phải tách 2 layer taluy ngắn và taluy dài ra vì như vậy chiều dài taluy ngắn và taluy dài có thể thay đổi riêng biệt nhau làm cho đường taluy mềm mại hơn. Để em thử nâng cấp lên " chỉ rải trên một đoạn của đường cong mà mình tuỳ ý đặt" xem sao nhé (vì trên tuyến nó thay đổi đoạn đào, đắp liên tụ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

Cái này khá hay đấy, tiện đây mình cũng xin góp một ý nhỏ như sau. đối với cái rải mái ta luy này thì như nacata nói hai đường này hai màu là đúng rồi (có thể là đỏ với trắng), bên cạnh đó thì đường ngắn(đỏ) có chiều dài =1/3 đường dài (trắng). và đường ngắn(đỏ) có độ dày bằng 3 lần đường dài(trắng), (có thể là 0.05 và 0.15)

Nacata sửa xong thì post lên cho anh em tham khảo với 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
chú nói sao chứ, cty tôi dùng mấy năm nay ko ai kêu ca zzậy

Rải taluy trên đường spline mới đẹp

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ú nói sao chứ, cty tôi dùng mấy năm nay ko ai kêu ca zzậy

Xin lỗi bác nhé vì em xem chưa kĩ lắm, Nhưng mà cái này em thấy cũng chưa đúng lắm. Vì theo em thì đường ngắn có chiều dài =1/3 đường dài. và đường ngắn có độ dày bằng 3 lần đường dài (Có thể làm hai màu khác nhau cho nó đẹp)). Em ko rành về lisp nên ko tự mình sửa được, bác có thể sửa nó như ý em dc không, dù sao cũng cám ơn bác vì đã chia sẽ.

:)

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à Lisp mà tôi hay dùng, mọi người cùng thưởng thức

;;; ======================== VE DUONG TALUY - LENH B1 (BATTER) =========================
;;; ================================================================================


=======
;;;================================== Testlay (Tao ten va mau cho layer moi===============================
(defun testlay (lay co / tam)
	(setq datalay (list ""))	  
			  (setq tbl (tblnext "layer" 1))
			  (while tbl
				  (setq tam (cdr (assoc 2 tbl)))
		(setq datalay (append datalay (list tam)))
				  (setq tbl (tblnext "layer"))
			   )
	(setq datalay (cdr datalay))
	(if (= (member lay datalay) nil)
 (command "LAYER" "n" lay "c" co lay  "s" lay "")
 (command "LAYER"   "s" lay "")
	)	
)
;; ============================================= Batter ================================================
(defun c:Batter()
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "aunits" 0)
  (setvar "angbase" (/ pi 2))
  (setvar "angdir" 1)
  (if (not lint) (setq lint 10.0))
  (setq int (getdist (strcat "\nInterval <" (rtos lint 2 3) ">: ")))
  (if int (setq lint int) (setq int lint))
  (command "line" (list 0.0 0.0) (list 0.0 0.0001) "")
  (if (tblsearch "block" "tadtick")
	 (command "block" "tadtick" "y" (list 0.0 0.0) (entlast) "")
	 (command "block" "tadtick" (list 0.0 0.0) (entlast) "")
  )
  (while (setq refent (entsel "\nSelect reference line: "))
  (command "undo" "group")
  (redraw (car refent) 3)
  (initget 1 "Cut Fill")
  (setq reply (getkword "\n[C]ut or [F]ill batter: "))
  (setq s (ssget))
  (command "measure" refent "b" "tadtick" "y" int)
  (setq p (ssget "p") cn 0)
  (if s
	 (progn
		(while (< cn (sslength p))
		   (setq en (entget (ssname p cn)) p0 (cdr (assoc 10 en)) pt1 p0 pt2 nil b (cdr (assoc 50 en)))
		   (entdel (ssname p cn))
		   (setq p1 (polar p0 (+ (/ pi 2) b) 0.0001))
		   (command "line" p0 p1 "")
		   (command "extend" s "" (list (entlast) p1) "")
		   (setq xent (entget (entlast)))
		   (setq xdist (distance (cdr (assoc 10 xent)) (cdr (assoc 11 xent))))
		   (if (not (equal xdist 0.0001 0.0001))
			  (setq pt2 (cdr (assoc 11 xent)))
			  (progn
				 (command "extend" s "" (list (entlast) p0) "")
				 (setq xent (entget (entlast)))
				 (setq xdist (distance (cdr (assoc 10 xent)) (cdr (assoc 11 xent))))
				 (if (not (equal xdist 0.0001 0.0001))
					(setq pt2 (cdr (assoc 10 xent)))
				 )
			  )
		   )
		   (entdel (entlast))
		   (if pt2
			  (if (= reply "Fill")
				 (if (= (rem cn 2) 0) (command "line" pt1 pt2 "")
					(command "line" pt1 (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)) "")
				 )
				 (if (= (rem cn 2) 0) (command "line" pt2 pt1 "")
					(command "line" pt2 (polar pt2 (angle pt2 pt1) (/ (distance pt2 pt1) 2)) "")
				 )
			  )
		   )
		   (setq cn (1+ cn))
		)
	 )
  )
  (command "undo" "en")
  )
  (setvar "blipmode" 1)
  (princ)
)
(prompt "\nDraw cut/fill batter slope lines.")
;====================== BAT1 (BATTER)===========================================
(defun c:B1( / mode)

(testlay "BONG" "8")
(setvar "osmode" 0)
(c:batter)
(setvar "blipmode" 0)
(setvar "osmode" 167)
)

Cảm ơn bác philipdn nhiều, nhưng đúng là lisp của bác bất cập thật. Em thấy trường hợp chân taluy và đỉnh taluy mà không song song mà gấp khúc thì ký hiệu taluy không chuẩn và đẹp lắm. Không bít còn lisp nào ổn hơn 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
Help me. Đây là Lisp dùng để rãi taluy của đường. Nó rất tiện lợi cho việc thể hiện mái dốc của đường đào hoặc đắp, nhưng có một khó khăn với tôi đó là nó chỉ rãi được trên đường thẳng và trên đường pline và cung tròn còn trên đường spline thì bó tay.

Xin các Bác chỉnh sửa dùng cho với. Cám ơn trước nghe.

TL1: dùng để rãi trên đường thẳng và pline.

TL2: dùng để rãi trên cung tròn.

http://www.cadviet.com/upfiles/TALUY.lsp

 

Bạn có dùng nova không. tôi thấy lệnh rải taluy trong menu phụ trợ rải taluy rất đẹp, cả trong đường cong và trong đường thẳng đó chứ

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

Sao không dùng lintype dạng taluy |i| vẽ tiện hơn không ? giải quyết đường tròn, arc và spline dễ dàng

 

e.jpg.

  • 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
Help me. Đây là Lisp dùng để rãi taluy của đường. Nó rất tiện lợi cho việc thể hiện mái dốc của đường đào hoặc đắp, nhưng có một khó khăn với tôi đó là nó chỉ rãi được trên đường thẳng và trên đường pline và cung tròn còn trên đường spline thì bó tay.

Xin các Bác chỉnh sửa dùng cho với. Cám ơn trước nghe.

TL1: dùng để rãi trên đường thẳng và pline.

TL2: dùng để rãi trên cung tròn.

http://www.cadviet.com/upfiles/TALUY.lsp

Cái này chỉ vẽ được taluy trên đường line, pline mình thấy không có tác dụng, circle thì thấy yêu cầu lằng nhằng quá mà toàn viết tắt nên chả hiểu(PT1,PT2 là gì?).Ưu điểm là chọn được phía đặt taluy

 

 

--------------------------------

Đây là lisp tôi sưu tầm và chỉnh sửa lại chút ít, có thể rải taluy cho các loại line, pline, spline, arc, circle ...

(Mới dừng ở việc vẽ taluy cho 1 đường, phần vẽ mái taluy giữa 2 đường tôi chưa sửa xong)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;vtl;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl ()
 (if (/= scale nil)
   (progn
     (setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
     (if (not (setq scaletmp (getint thongbao)))
(setq scaletmp scale)
     )
   )
   (progn
     (setq thongbao "Ty le ban ve ? <1/1000>:")
     (if (not (setq scaletmp (getint thongbao)))
(setq scaletmp 1000)
     )
   )
 )

 (setq scale scaletmp)

 (setq Defaultdist (* (* scale 2) 0.002))
 (if (setq tg (getreal	(strcat	"\nKhoang cach ky hieu ta luy <"
			(rtos Defaultdist 2 2)
			">:"
		)
       )
     )
   (setq Defaultdist tg)
 )

 (setq	chieutaluy1
 1
sodoan 0
 )
)

(defun nsl1 ()

 (setq
   ktdoantaluy1 2
   tg		 (getreal (strcat "\nChieu dai doan ngan<"
			  (rtos ktdoantaluy1 2 2)
			  ">:"
		  )
	 )
 )
 (if tg
   (setq ktdoantaluy1 tg)
 )
 (setq
   ktdoantaluy2 6
   tg		 (getreal (strcat "\nChieu dai doan dai<"
			  (rtos ktdoantaluy2 2 2)
			  ">:"
		  )
	 )
 )
 (if tg
   (setq ktdoantaluy2 tg)
 )
 (setq
   khoangcachtl 2
   tg		 (getreal (strcat "\nKhoang cach giua cac doan<"
			  (rtos khoangcachtl 2 2)
			  ">:"
		  )
	 )
 )
 (if tg
   (setq khoangcachtl tg)
 )
 (setq
   sodoanngan 3
   tg	       (getint (strcat "\nSo doan ngan trong 1 doan dai<"
		       (rtos sodoanngan 2 0)
		       ">:"
	       )
       )
 )
 (if tg
   (setq sodoanngan tg)
 )

)
(Defun PlMake (Plist)			;  Create polyline entities
 (entmake '((0 . "POLYLINE")))
 (setq	n  (length Plist)
ic 0
 )
 (while (< ic n)
   (entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
   (setq ic (1+ ic)
   )
 )
 (entmake '((0 . "SEQEND")))

)
;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
 (setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
 (setq ketthuc 1)
 (if (< sodoan sodoanngan)
   (progn
     (setq ktdoantaluy ktdoantaluy1)
     (setq sodoan (1+ sodoan))
   )
   (progn
     (setq ktdoantaluy ktdoantaluy2)
     (setq sodoan 0)
   )
 )
 (setq p2 (polar p1 pvt ktdoantaluy))
 (plmake (list p1 p2))
 (setq dem (1+ dem))
)

(Defun xddsd (com epl kc / e0 e p dsd)
 (setq e0 (entlast))
 (while e0
   (setq e e0)
   (setq e0 (entnext e0))
 )
 (command com epl kc)
 (setq e (entnext e))
 (while e
   (setq p (cdr (assoc 10 (entget e))))
   (if	p
     (setq dsd (cons p dsd))
   )
   (setq e (entnext e))
 )
 (command "_.Undo" 1)
 (setq dsd dsd)
)
				; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
 (setq dem 0)
 (setq e (entget (car ep)))
 (if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
  (= (cdr (assoc 0 e)) "POLYLINE")
  (= (cdr (assoc 0 e)) "SPLINE")
  (= (cdr (assoc 0 e)) "LINE")
  (= (cdr (assoc 0 e)) "ARC")
  (= (cdr (assoc 0 e)) "CIRCLE")
     )

   (setq ketthuc 1)
   (prompt "\nDoi tuong duoc chon khong hop le")
 )
 (if ketthuc
   (progn
     (setq thutu 0)
     (setq dsd (xddsd "_.Measure" ep khoangcachtl))
     (setq p1 (car dsd))
     (repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
     )
   )
 )
 (setq dem dem)
)

;;;==================================================
(Defun C:vtl1 (/ ep chon lai solan chon)

 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (command "undo" "g")
 (nsl)

 (setq ep 1)
 (while ep
   (setq solan	0
  chieutaluy 1
   )
   (setq ep (entsel "\nChon doi tuong ve ta luy..."))

   (if	ep
     (progn
(nsl1)
(setq solan (vetaluy ep))
(initget "Undo Change")
(while
  (setq chon (getkword "Undo/Change : "))
   (if (= chon "Undo")
     (command "_.Undo" solan)
   )
   (if (= chon "Change")
     (progn
       (nsl1)

       (setq chieutaluy -1)
       (command "_.Undo" solan)
       (setq solan (vetaluy ep))

     )
   )

  (initget "Undo Change")
)

     )
   )
 )
 (command "undo" "e")
)

Cái này vẽ được taluy trên cả line,spline,pline và cung tròn.Nhưng nhược điểm là không chọn được chiều đặt taluy.

-----------------------------------------------------------------

Đây là Lisp mà tôi hay dùng, mọi người cùng thưởng thức

;;; ======================== VE DUONG TALUY - LENH B1 (BATTER) =========================
;;; ================================================================================




=======
;;;================================== Testlay (Tao ten va mau cho layer moi===============================
(defun testlay (lay co / tam)
	(setq datalay (list ""))	  
			  (setq tbl (tblnext "layer" 1))
			  (while tbl
				  (setq tam (cdr (assoc 2 tbl)))
		(setq datalay (append datalay (list tam)))
				  (setq tbl (tblnext "layer"))
			   )
	(setq datalay (cdr datalay))
	(if (= (member lay datalay) nil)
 (command "LAYER" "n" lay "c" co lay  "s" lay "")
 (command "LAYER"   "s" lay "")
	)	
)
;; ============================================= Batter ================================================
(defun c:Batter()
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "aunits" 0)
  (setvar "angbase" (/ pi 2))
  (setvar "angdir" 1)
  (if (not lint) (setq lint 10.0))
  (setq int (getdist (strcat "\nInterval <" (rtos lint 2 3) ">: ")))
  (if int (setq lint int) (setq int lint))
  (command "line" (list 0.0 0.0) (list 0.0 0.0001) "")
  (if (tblsearch "block" "tadtick")
	 (command "block" "tadtick" "y" (list 0.0 0.0) (entlast) "")
	 (command "block" "tadtick" (list 0.0 0.0) (entlast) "")
  )
  (while (setq refent (entsel "\nSelect reference line: "))
  (command "undo" "group")
  (redraw (car refent) 3)
  (initget 1 "Cut Fill")
  (setq reply (getkword "\n[C]ut or [F]ill batter: "))
  (setq s (ssget))
  (command "measure" refent "b" "tadtick" "y" int)
  (setq p (ssget "p") cn 0)
  (if s
	 (progn
		(while (< cn (sslength p))
		   (setq en (entget (ssname p cn)) p0 (cdr (assoc 10 en)) pt1 p0 pt2 nil b (cdr (assoc 50 en)))
		   (entdel (ssname p cn))
		   (setq p1 (polar p0 (+ (/ pi 2) b) 0.0001))
		   (command "line" p0 p1 "")
		   (command "extend" s "" (list (entlast) p1) "")
		   (setq xent (entget (entlast)))
		   (setq xdist (distance (cdr (assoc 10 xent)) (cdr (assoc 11 xent))))
		   (if (not (equal xdist 0.0001 0.0001))
			  (setq pt2 (cdr (assoc 11 xent)))
			  (progn
				 (command "extend" s "" (list (entlast) p0) "")
				 (setq xent (entget (entlast)))
				 (setq xdist (distance (cdr (assoc 10 xent)) (cdr (assoc 11 xent))))
				 (if (not (equal xdist 0.0001 0.0001))
					(setq pt2 (cdr (assoc 10 xent)))
				 )
			  )
		   )
		   (entdel (entlast))
		   (if pt2
			  (if (= reply "Fill")
				 (if (= (rem cn 2) 0) (command "line" pt1 pt2 "")
					(command "line" pt1 (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)) "")
				 )
				 (if (= (rem cn 2) 0) (command "line" pt2 pt1 "")
					(command "line" pt2 (polar pt2 (angle pt2 pt1) (/ (distance pt2 pt1) 2)) "")
				 )
			  )
		   )
		   (setq cn (1+ cn))
		)
	 )
  )
  (command "undo" "en")
  )
  (setvar "blipmode" 1)
  (princ)
)
(prompt "\nDraw cut/fill batter slope lines.")
;====================== BAT1 (BATTER)===========================================
(defun c:B1( / mode)

(testlay "BONG" "8")
(setvar "osmode" 0)
(c:batter)
(setvar "blipmode" 0)
(setvar "osmode" 167)
)

Cái này phải vẽ 2 đường giới hạn đỉnh và chân của đường vẽ nét taluy, rất bất tiện

 

==>> Túm lại cái của snowman là ngon nhất nhưng làm sao thêm chức năng chọn chiều đặt taluy thì perfect!

 

Hàng về rồi...hihi

 

http://www.cadviet.com/upfiles/VTLW1.lsp

 

Thử nghiên cứu cái này đi.

 

1. Load vào CAD

2. Lệnh TL0 để khai báo tham số

3. Lệnh TL1 để vẽ đường taluy đơn

4. Lệnh TL2 để vẽ đường taluy đôi

Thêm cái này,vẽ pline tốt nhưng cũng k chọn được chiề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
Cái này chỉ vẽ được taluy trên đường line, pline mình thấy không có tác dụng, circle thì thấy yêu cầu lằng nhằng quá mà toàn viết tắt nên chả hiểu(PT1,PT2 là gì?).Ưu điểm là chọn được phía đặt taluy

--------------------------------

 

Cái này vẽ được taluy trên cả line,spline,pline và cung tròn.Nhưng nhược điểm là không chọn được chiều đặt taluy.

-----------------------------------------------------------------

 

Cái này phải vẽ 2 đường giới hạn đỉnh và chân của đường vẽ nét taluy, rất bất tiện

 

==>> Túm lại cái của snowman là ngon nhất nhưng làm sao thêm chức năng chọn chiều đặt taluy thì perfect!

Thêm cái này,vẽ pline tốt nhưng cũng k chọn được chiề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

Vẽ ký hiệu taluy, đường hàn, đường dây điện, đường nước .... có lẽ nên dùng file.lin là nhanh nhất.

Trong Express>Tools có Make Linetype và Make Shape giúp ta nhanh chóng tạo ra các linetype theo ý riê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
Help me. Đây là Lisp dùng để rãi taluy của đường. Nó rất tiện lợi cho việc thể hiện mái dốc của đường đào hoặc đắp, nhưng có một khó khăn với tôi đó là nó chỉ rãi được trên đường thẳng và trên đường pline và cung tròn còn trên đường spline thì bó tay.

Thấy các bạn yêu cầu nhiều về lisp vẽ taluy và trên diễn đàn có share nhiều lisp. Tuy nhiên sau khi dùng thử mọi cái tôi thấy cái lisp của Lamteco đưa lên là hợp lý; tuy nhiên nó bị lỗi nên khi xài tôi phát hiện ra và hiệu chỉnh lại .

Các lệnh vẫn giữ nguyên:

1/ Khai báo các kiểu nét taluy dài ngắn, khoảng cách và số vạch ngắn chen giữa vạch dài = lệnh: VTL0;

2/ Vẽ taluy cho 1 đường riêng biệt = lệnh: VTL1, cho phép chọn đổi bên trái sang phải;

3/ Vẽ taluy chọn đường đỉnh mái taluy và đường chân mái taluy, cho phép đổi ngược lại = lệnh: VTL2.

(setq ktdoantaluy1 0.2 ktdoantaluy2 0.4 khoangcachtl 0.2 chieutaluy 1
sodoan 0 sodoanngan 4)
;Ve taluy tren 1 doan
(defun ve1doantaluy ( p1 p2 / pvt diemcu ktdoantaluy ketthuc )
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(command "_.Line" p1 p2 "")
(setq dem (1+ dem))
)

(Defun xddsd ( com epl kc / e0 e p dsd )
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
; ve ta luy cho 1 doi tuong
(Defun vetaluy ( ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
(= (cdr (assoc 0 e)) "SPLINE")
) (setq ketthuc 1))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE") (= (cdr (assoc 0 e)) "POLYLINE"))
(setq ketthuc 1)

)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
)
)
)
(setq dem dem)
)
(Defun C:vtl1 ( / il ill ep chon lai solan )
(setq il (getvar "cecolor"))
(setq ill (getvar "osmode"))
(setvar "osmode" 0)
;(setvar "cecolor" "9")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "begin")
(setq ep 1)
(while ep
(setq solan 0 chieutaluy 1)
(setq ep (entsel))
(if ep
(progn
(setq solan (vetaluy ep))
(setq chon (getstring "\nU-UNDO/D-Doi nguoc lai:"))
)
)
(if chon (setq chon (strcase chon nil)))
(if (= chon "U")
(command "_.Undo" solan)
)
(if (= chon "D")
(progn
(setq chieutaluy -1)
(command "_.Undo" solan)
(setq solan (vetaluy ep))
)
)
(setq chon nil)
)
(setvar "cecolor" il)
(setvar "osmode" ill)
(command "undo" "end")
)
(Defun C:vtl0 ( / tg )
(setq tg (getreal (strcat "Chieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
(if tg (setq ktdoantaluy1 tg))
(setq tg (getreal (strcat "Chieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
(if tg (setq ktdoantaluy2 tg))
(setq tg (getreal (strcat "Khoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
(if tg (setq khoangcachtl tg))
(setq tg (getint (strcat "So doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))
(if tg (setq sodoanngan tg))
)

(Defun ve1doantaluy1 ( p1 p2 / d pv diemcu ktdoantaluy ketthuc )
(if (and p1 p2)
(progn
(setq ketthuc 1)
(setq pv (angle p1 p2))
(setq d (distance p1 p2))
(setq d (* d (/ ktdoantaluy1 ktdoantaluy2)))
(setq pv (polar p1 pv d))
(if (< sodoan sodoanngan)
(progn
(setq p2 pv)
(setq sodoan (1+ sodoan))
)
(progn
(setq p2 p2)
(setq sodoan 0)
)
)
(command "_.Line" p1 p2 "")
(setq dem (1+ dem))
)
)
(setq dem dem)
)

(Defun vetaluy1 ( ep1 ep2 dao / le e1 e2 ketthuc them thutu )
(setq dem 0)
(setq e1 (entget (car ep1)))
(setq e2 (entget (car ep2)))
(if (and (or (= (cdr (assoc 0 e1)) "POLYLINE")
(= (cdr (assoc 0 e1)) "LINE")
(= (cdr (assoc 0 e1)) "ARC")
(= (cdr (assoc 0 e1)) "CIRCLE")
(= (cdr (assoc 0 e1)) "LWPOLYLINE")
(= (cdr (assoc 0 e1)) "SPLINE"))
(or (= (cdr (assoc 0 e2)) "POLYLINE")
(= (cdr (assoc 0 e2)) "LINE")
(= (cdr (assoc 0 e2)) "ARC")
(= (cdr (assoc 0 e2)) "CIRCLE")
(= (cdr (assoc 0 e2)) "LWPOLYLINE")
(= (cdr (assoc 0 e2)) "SPLINE"))
) (setq ketthuc 1))
(if (and (= (cdr (assoc 0 e1)) "POLYLINE") (= (cdr (assoc 0 e2)) "LWPOLYLINE"))
(setq ketthuc 1)

)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd1 (xddsd "_.Measure" ep1 khoangcachtl))
(setq dsd2 (xddsd "_.Divide" ep2 (length dsd1)))
(if dao
(setq dsd2 (reverse dsd2))
)
(repeat (length dsd1)
(setq p1 (nth thutu dsd1))
(setq p2 (nth thutu dsd2))
(setq thutu (1+ thutu))
(ve1doantaluy1 p1 p2)
)
)
)
(setq dem dem)
)

(Defun C:vtl2 ( / ep1 ep2 chon lai solan dsd1 dsd2 )
(setq il (getvar "cecolor"))
(setq ill (getvar "osmode"))
(setvar "osmode" 0)
;(setvar "cecolor" "9")
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "begin")
(setq solan 0 ep1 1 ep2 1)
(while (and ep1 ep2)
(setq chieutaluy 1)
(setq ep1 (entsel "\nDoi tuong thu nhat:"))
(setq ep2 (entsel "\nDoi tuong thu hai:"))
(if (and ep1 ep2)
(progn
(setq solan (vetaluy1 ep1 ep2 nil))
(setq chon (getstring "\nU-UNDO/D-Doi nguoc lai:"))
)
)
(if chon (setq chon (strcase chon nil)))
(if (= chon "U")
(command "_.Undo" solan)
)
(if (= chon "D")
(progn
(command "_.Undo" solan)
(setq chieutaluy -1)
(setq solan (vetaluy1 ep2 ep1 nil))
)
)
(setq chon nil)
)
(command "undo" "end")
(setvar "cecolor" il)
(setvar "osmode" ill)
)

Mèo tui test thấy ngon không thua gì các lệnh RTL của Nova, các bạn test lại xem sao

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 chưa thử lisp của bạn xem có hay không nhưng mình đã tìm tất cả các lisp vẽ taluy trên diễn đàn này và thấy lisp sau là dùng ok nhất,đáp ứng được tất cả các yêu cầu của mình http://www.cadviet.com/upfiles/2/vtl.lsp

và chỉ có 1 nhược điểm duy nhất là mình muốn dải taluy mà các net taluy không vuông góc với đường đỉnh mái taluy mà nằm theo phương thẳng đứng thì chưa có lisp nào đáp ứng 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
Mình chưa thử lisp của bạn xem có hay không nhưng mình đã tìm tất cả các lisp vẽ taluy trên diễn đàn này và thấy lisp sau là dùng ok nhất,đáp ứng được tất cả các yêu cầu của mình http://www.cadviet.com/upfiles/2/vtl.lsp

và chỉ có 1 nhược điểm duy nhất là mình muốn dải taluy mà các net taluy không vuông góc với đường đỉnh mái taluy mà nằm theo phương thẳng đứng thì chưa có lisp nào đáp ứng cả.

Bạn cứ test cái mình vừa hiệu chỉnh sẽ thấy ư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

Mình mới test và xin góp ý thế này: khi chọn đối tượng vẽ tauy là đường spline thì thông báo là " doi tuong duoc chon khong hop le"> như vậy lisp này không dải được taluy trên đường spline hả 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
Mình mới test và xin góp ý thế này: khi chọn đối tượng vẽ tauy là đường spline thì thông báo là " doi tuong duoc chon khong hop le"> như vậy lisp này không dải được taluy trên đường spline hả bạn?

Uh đúng rồi vì mình thấy Spline ít ai xài, thông thường 1 pline gãy thì nên dùng PE rồi gõ Spline thì cũng đẹp và dễ quản lý hơn đường Spline. Tuy nhiên nếu bạn thích thì mình hiệu chỉnh thêm phần chọn Spline vô lisp trên rồi đấy ; bạn test lại 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

Okie, đã dải được trên spl nhưng khi hết 1 lần dải thì không Undo được các lệnh trước đó bằng 1 lần ấn Ctrl+Z mà mỗi lần ấn chỉ bỏ đi được 1 nét vẽ taluy.Bạn có cách nào rải nét ngắn và dài không vuông góc với đường cần dải taluy không, mà đặt nó nằm theo phương thẳng đứng(trục oy)

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

Sao mỗi lần mình sử dụng thì các osnap lại bị tắt hết vậy bạn? Hơn nữa sau khi nhập các thông số bằng vtl0 rồi dùng cách vẽ vtl1 để chọn đối tượng thì taluy lại ko nằm trên đối tượ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

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
Đăng nhập để thực hiện theo  

×