Đến nội dung


Hình ảnh
* * - - - 1 Bình chọn

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


  • Please log in to reply
53 replies to this topic

#1 daulau00

daulau00

    biết zoom

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

Đã gửi 19 September 2008 - 08:53 AM

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.c...files/TALUY.lsp
  • 0

#2 vndesperados

vndesperados

    biết lệnh xref

  • Members
  • PipPipPipPipPipPipPip
  • 547 Bài viết
Điểm đánh giá: 253 (khá)

Đã gửi 19 September 2008 - 09:15 AM

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.c...files/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
  • 0

#3 minh2453

minh2453

    biết lệnh scale

  • Members
  • PipPipPip
  • 146 Bài viết
Điểm đánh giá: 42 (tàm tạm)

Đã gửi 19 September 2008 - 01:43 PM

gần giống lisp đường hàn :)
  • 0
Đừng giấu những gì bạn biết và những thứ bạn không biết

#4 dacvien2007

dacvien2007

    biết vẽ polygon

  • Members
  • PipPip
  • 75 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 19 September 2008 - 04:19 PM

Nhờ Bạn Post lên cho mình xin với
Cám ơn
  • 0

#5 Snowman

Snowman

    biết lệnh mirror

  • Members
  • PipPipPip
  • 155 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 20 September 2008 - 07:10 PM

Đâ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")
)

  • 2

. - ' * ' - .. - ... "Sống trong đời sống cần có một tấm lòng..." . - ' * ' - .. -
-----------------------------------------------------------------------------------

Hình đã gửi Hình đã gửi


#6 nataca

nataca

    biết lệnh adcenter

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

Đã gửi 20 September 2008 - 10:11 PM

Đâ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)
  • 1

#7 xuantran15

xuantran15

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 295 Bài viết
Điểm đánh giá: 112 (tàm tạm)

Đã gửi 21 September 2008 - 08:08 AM

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
:)
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#8 xuantran15

xuantran15

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 295 Bài viết
Điểm đánh giá: 112 (tàm tạm)

Đã gửi 21 September 2008 - 05:09 PM

:)
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#9 nataca

nataca

    biết lệnh adcenter

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

Đã gửi 22 September 2008 - 04:42 PM

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

#10 xuantran15

xuantran15

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 295 Bài viết
Điểm đánh giá: 112 (tàm tạm)

Đã gửi 22 September 2008 - 10:21 PM

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ẽ.
:)
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#11 minhnghi

minhnghi

    biết vẽ arc

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

Đã gửi 17 May 2009 - 09:41 PM

Đâ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
  • 0
- Gà con vẽ CAD -

#12 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 22 May 2009 - 10:45 PM

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.c...files/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ứ
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#13 tranchan

tranchan

    biết lệnh break

  • Members
  • PipPipPipPip
  • 221 Bài viết
Điểm đánh giá: 93 (tàm tạm)

Đã gửi 22 May 2009 - 11:14 PM

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

Hình đã gửi.
  • 1

#14 zippo.113

zippo.113

    biết pan

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

Đã gửi 09 October 2009 - 04:28 PM

Đoạn lsp nay khá hay đấy ! Cố gắng phát huy nhé ! :bigsmile:
  • 0

#15 codered8x

codered8x

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 30 April 2010 - 04:26 PM

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.c...files/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.
  • 0

#16 tranduc194

tranduc194

    Chưa sử dụng CAD

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

Đã gửi 06 May 2010 - 11:11 AM

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.


  • 0

#17 tranduc194

tranduc194

    Chưa sử dụng CAD

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

Đã gửi 06 May 2010 - 11:14 AM

sao ko dung taluy topo "ma" cho nhanh!
  • 0

#18 hoa35ktxd

hoa35ktxd

    biết lệnh move

  • Members
  • PipPipPip
  • 125 Bài viết
Điểm đánh giá: 38 (tàm tạm)

Đã gửi 06 May 2010 - 04:32 PM

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

#19 meohoang

meohoang

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 811 Bài viết
Điểm đánh giá: 342 (khá)

Đã gửi 08 May 2010 - 07:34 PM

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

#20 codered8x

codered8x

    biết lệnh copy

  • Members
  • PipPipPip
  • 119 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 08 May 2010 - 09:07 PM

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.c...files/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ả.
  • 0