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

#21 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 - 09:41 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ả.

Bạn cứ test cái mình vừa hiệu chỉnh sẽ thấy ưng ý
  • 0

#22 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 - 10:05 PM

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

#23 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 - 11:14 PM

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

#24 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 09 May 2010 - 09:24 AM

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

#25 nguyentieu

nguyentieu

    biết vẽ circle

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

Đã gửi 03 June 2010 - 09:27 PM

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 đó ?
  • 0

#26 themanh01

themanh01

    biết zoom

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

Đã gửi 18 June 2010 - 05:08 PM

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

mình thấy cái này rất hay nhưng thêm được mầu và layer khác nhau cho đoạn dài và đoạn ngắn thì ngon.
  • 0

#27 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 19 June 2010 - 11:29 AM

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

Lisp vẽ taluy của Bạn rất hay, mong được bạn cải tiến thêm để giúp anh em, vi yêu cầu sau :
Nét dài và ngắn thể hiện màu khác nhau,
Khi cần hiệu chỉnh chọn taluy để hiệu chỉnh nét dài , nét ngắn khoảng cách.
Khi vẽ Taluy qua 2 đường vlt2 , khi khi đường chân có thay đổi thì nét chảy taluy sẽ được thay đổi theo.
Rất mong được Bạn giúp.
  • 0

#28 Demenzizu

Demenzizu

    biết zoom

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

Đã gửi 20 June 2010 - 01:06 AM

cái này hình như là lisp tedi thì phải rải taluy khi vẽ ra kiểu 2 tức là vtl2 thì nó lại ra như thế này thì không đúng nhờ các cao thủ chỉnh lại giúp cho vì nó phải vuông góc với hai canh là 2 đường trắc polyline đã có trên

  • 0

#29 pt_minh

pt_minh

    Chưa sử dụng CAD

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

Đã gửi 23 November 2010 - 11:17 AM

Thêm cho anh em lisp ve taluy của tedi mình vừa tìm thấy trong máy mình, chắc là tuổi của nó cũng được tròn chục rui.

;;;=======================================
;;; TLF draw fill
;;; TLC draw cut
;;; TLSET Set global variable for double tl
;;; SETTL set for single tl
;;; TL draw single TL
;;; USES WORLD COORDINATE SYSTEM
(setq distmin 1.0)
(setq distmax 3.5)
(setq segmin 1.0)
;====================================================================
(setq distmin 0.5) ; min distance between segment
(setq distmax 1.8) ; max distance between segment
(setq segmin 1.0) ; khoang cach noi suy khi ve ta luy
(setq kctl 1) ; distance between line
(setq dngan 1) ; Length of short line
(setq ddai 2) ; Length of long line
(setq chieutl 1)
(setq chieutl 1)
;=================================================================
;============== Doc toa do duong polyline =====
(defun readpl (pl / e l ds p)
(if (not (equal pl etcam)) (progn
(setq ds '())
(setq e (entget pl))
(setq l (cdr (assoc 0 e)))
(if (= l "POLYLINE")
(progn
(setq pl (entnext pl))
(setq e (entget pl))
(setq l (cdr (assoc 0 e)))
(while (= l "VERTEX")
(setq p (cdr (assoc 10 e)))
(setq ds (cons p ds))
(setq pl (entnext pl))
(setq e (entget pl))
(setq l (cdr (assoc 0 e)))
)
)
)
(if (= l "LINE")
(setq ds (list
(cdr(assoc 11 e))
(cdr(assoc 10 e))
)
)
)
(setq ds (reverse ds))
(if (= l "LWPOLYLINE")
(setq ds (xddstd pl) )
)
))
(setq ds ds)
)
;;;--- Setup for taluy --
(defun c:tlset (/ minimum maximum )
(setq minimum (getreal (strcat "Minimum Distance [" (rtos distmin 2 2) "]: " ) ))
(if minimum (setq distmin minimum))
(setq maximum (getreal (strcat "Maximum Distance [" (rtos distmax 2 2) "]: " ) ))
(if maximum (setq distmax maximum))
(setq maximum (getreal (strcat "Segmin [" (rtos segmin 2 2) "]: " ) ))
(if maximum (setq segmin maximum))
)
;;;---- lay ds td cua pline --
(defun xddstd ( pl / e ds len tt p)
(setq minimum (getreal (strcat "Minimum Distance [" (rtos distmin 2 2) "]: " ) ))
(if minimum (setq distmin minimum))
(setq maximum (getreal (strcat "Maximum Distance [" (rtos distmax 2 2) "]: " ) ))
(if maximum (setq distmax maximum))
(setq maximum (getreal (strcat "Segmin [" (rtos segmin 2 2) "]: " ) ))
(if maximum (setq segmin maximum))
)
;;;--- Xac dinh doan gan nhat --
(defun xdmin(dstd p / p1 p2 len tt d dmin k)
(setq len (length dstd))
(setq tt 0)
(setq k tt)
(setq dmin (distance (car dstd) p))
(repeat (- len 1)
(setq p1 (nth tt dstd))
(setq tt (+ tt 1))
(setq p2 (nth tt dstd))
(setq d (distance p1 p))
(if (< d dmin)
(progn
(setq dmin d)
(setq k (- tt 1))
)
)
(setq d (distance p2 p))
(if (< d dmin)
(progn
(setq dmin d)
(setq k tt)
)
)
)
(if (> k 0)
(setq tt (- k 1))
(setq tt 0)
)
(setq p1 (nth tt dstd))
(setq tt (+ tt 1))
(setq p2 (nth tt dstd))
(list p1 p2)
)
;----- Xac dinh chieu p - pl
(defun chieu ( p / ds a1 a2 a c)
;(setq ds (xddstd pl))
(setq ds ds111 )
(setq ds111 ds)
(if ds (progn
(setq ds (xdmin ds p))
(setq a1 (angle (car ds) (cadr ds) ))
(setq a2 (angle (car ds) p ))
(setq a (- a2 a1))
;(if (and (> a 0) (< a pi))
(if (> (sin a) 0)
(setq c 1)
(setq c -1)
)
))
(setq c c)
)
;;;- ke mot duong thang ---
(defun mkl (p1 p2 / e)
(setq p1 (cons 10 p1) )
(setq p2 (cons 11 p2) )
(setq e (list
'(0 . "LINE")
p1
p2
))
(entmake e)
)
;=================================
;;;============================================================
;;; Ve duong taluy
(defun tlx (/ dsp pl p1 p2 ag pc pl1 tt l sumdist dist pv overdist cl el pchieu)
(setq ds111 nil)
(setq pl (entsel "First Polyline"))
(redraw (car pl) 3)
(setq pl1 (entsel "\n Second Polyline"))
(redraw (car pl1) 3)
;(setq pchieu (getpoint "\nside of Polyline"))
(setq pchieu (cadr pl1))
(redraw (car pl) 4)
(redraw (car pl1) 4)
(if (and pl pl1) (progn
;;;---------------------
;(setq dsp (xddstd (car pl)))
(setq ds111 (dspm pl segmin))
(setq dsp ds111)
(setq dsxoa (ssadd))
(setq pc (cadr pl1))
(setq pl1 (car pl1))
;------------------------
(setq chieutl (chieu pchieu))
(setq tt 0)
(setq l (-(length dsp)1))
(setq sumdist 0)
;--------
(while (< tt l)
(progn
(setq distover (- sumdist))
(setq p1 (nth tt dsp))
(setq tt (+ tt 1))
(setq p2 (nth tt dsp))
(setq sumdist (distance p1 p2))
(setq pv (angle p1 p2))
(setq p1 (polar p1 pv distover) );jjjj
(setq sumdist (- sumdist distover))
(while (> sumdist 0)
(setq dist (veline p1 pv chieutl pl1))
(if (or (not dist) (< dist distmin))
(setq dist distmin)
)
(if (> dist distmax)
(setq dist distmax)
)
(setq p1 (polar p1 pv dist) )
(setq sumdist (- sumdist dist))
)
)
)
;-------
))
(setq dscuoi dsxoa)
)
;----- Xoa cuoi ---
(defun c:utl ()
(command "ERASE" dsxoa "")
)
;---- Ve 1 duong va keo dai -----
(defun veline ( p1 ag chieutl pl1 / ag vd kq dist ec em)
(setq ag (+ ag (*(/ pi 2)chieutl)) )
(setq p2 (polar p1 ag segmin))
(mkl p1 p2)
;------------------
(setq vd (entlast))
(REDRAW VD 3)
(setq ec (entget vd))
(setq vd (list vd p2))
(command "EXTEND" pl1 "" vd "" )
(setq vd (car vd))
(setq em (entget vd))
(if (equal ec em)
(entdel vd)
(progn
(setq p1 (cdr (assoc 10 em)))
(setq p2 (cdr (assoc 11 em)))
(setq kq (/(mykc p1 p2)2))
(setq dsxoa (ssadd vd dsxoa))
)
)
(setq kq kq)
)
;---- doi thanh doan dap ------
(defun nganf (vd / e p1 p2 d)
(if vd (progn
(setq e (entget vd))
(setq p1 (cdr (assoc 10 e ) ))
(setq p2 (cdr (assoc 11 e ) ))
(setq d (/(mykc p1 p2)2))
(if (> d distmax)
(setq d distmax)
)
(setq pv (angle p1 p2))
(setq p2 (polar p1 pv d))
(setq e (subst (cons 11 p2) (assoc 11 e) e ))
(entmod e)
(entupd vd)
))
)
;---- ve ta luy dao --
(defun c:tlc ( / l tt e)
(command "UNDO" "group")
(setq dscuoi nil)
(command "LAYER" "m" "TLCUT" "")
(tlx)
(if dscuoi
(progn
(setq l (sslength dscuoi))
(setq tt 0)
(repeat (+(/ l 2)1)
(setq e (ssname dscuoi tt))
(setq tt (+ tt 2))
(nganc e)
)
)
)
(command "UNDO" "end")
)
;---- doi thanh doan dao ------
(defun nganc (vd / e p1 p2 d)
(if vd (progn
(setq e (entget vd))
(setq p1 (cdr (assoc 10 e ) ))
(setq p2 (cdr (assoc 11 e ) ))
(setq d (/(mykc p1 p2)2))
(if (> d distmax)
(setq d distmax)
)
(setq pv (angle p2 p1))
(setq p1 (polar p2 pv d))
(setq e (subst (cons 10 p1) (assoc 10 e) e ))
(entmod e)
(entupd vd)
))
)
;---- ve ta luy dap --
(defun c:tlf ( / l tt e)
(command "UNDO" "group")
(command "LAYER" "m" "TLFIL" "")
(setq dscuoi nil)
(tlx)
(if dscuoi
(progn
(setq l (sslength dscuoi))
(setq tt 0)
(repeat (+(/ l 2)1)
(setq e (ssname dscuoi tt))
(setq tt (+ tt 2))
(nganf e)
)
)
)
(command "UNDO" "end")
)
;-- tinh kc 2 diem ---
(defun mykc (p1 p2 / x1 y1 x2 y2 dx dy)
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq x2 (car p2))
(setq y2 (cadr p2))
(setq dx (- x2 x1))
(setq dy (- y2 y1))
(sqrt (+(* dx dx) (* dy dy)))
)
;--- Lay danh sach diem bang mesure ---
(defun dspm (e segmin / el p dskq sst l)
;(setq e (entsel))
(setq el (entlast))
(setq sst (ssadd))
(command "MEASURE" e segmin)
(setq el (entnext el))
(while el
(setq p (cdr (assoc 10 (entget el) ) ))
(setq l (cdr (assoc 0 (entget el) ) ))
(if (and (= l "POINT") p)
(setq dskq (cons p dskq))
)
(setq sst (ssadd el sst))
(setq el (entnext el))
)
(command "ERASE" sst "")
(setq dskq (reverse dskq))
)
;;;=======================================
TL - Ve taluy
;;;=======================================
;;; Ve ta luy
;;;-------------------------
;;; Ve duong taluy
(defun c:tl (/ pl el e0 es p1 p2 ag ss ek cl pc)
(command "UNDO" "group")
(command "LAYER" "m" "slopes" "")
(setq pl (entsel))
(if pl (progn
(setq pc (getpoint "Side of TL"))
(setq chieutl (chieupl (car pl) pc ))
(setq el (entlast))
(command "MEASURE" pl kctl)
(setq ek (entlast))
(setq ss (ssadd))
;--------
(while (and el
(not (equal el ek) )
)
(setq el (entnext el))
(if el (setq ss (ssadd el ss)) )
(if el
(setq es (entnext el))
)
(if (and el es (= (cdr (assoc 0 (entget el))) "POINT") )
(progn
(setq p1 (cdr(assoc 10 (entget el))) )
(setq p2 (cdr(assoc 10 (entget es))) )
;-------------
(if (not(equal el ek))(progn
(setq ag (angle p1 p2))
(setq ag (+ ag (*(/ pi 2)chieutl)) )
))
(if cl
(setq p2 (polar p1 ag dngan))
(setq p2 (polar p1 ag ddai))
)
(if cl
(setq cl nil)
(setq cl 1)
)
;(command "LINE" p1 p2 "")
(mkl p1 p2)
;---------------------
)
)
)
;-------
(command "ERASE" ss "")
))
(command "UNDO" "end")
)
;----------------
;----- Xac dinh chieu p - pl
(defun chieupl (pl p / ds a1 a2 a c)
;(setq ds (xddstd pl))
(setq c 1)
(setq ds (readpl pl))
(if ds (progn
(setq ds (xdmin ds p))

(setq a1 (angle (car ds) (cadr ds) ))
(setq a2 (angle (car ds) p ))
(setq a (- a2 a1))
(if (and (> a 0) (< a pi))
(setq c 1)
(setq c -1)
)
))
(setq c c)
)

;;;;;;;;;;;;;;;
(defun c:settl (/ a1 a2 a3)
(setq a1 (getstring (strcat "Distance between line " (rtos kctl 2 2) ": " ) ))
(setq a2 (getstring (strcat "\nLength of short line " (rtos dngan 2 2)": " ) ))
(setq a3 (getstring (strcat "\nLength of long line " (rtos ddai 2 2) ": " ) ))
(if (/= a1 "")
(setq kctl (atof a1))
)
(if (/= a2 "")
(setq dngan (atof a2))
)
(if (/= a3 "")
(setq ddai (atof a3))
)
)

;========= AUTO CONNECT 2d POLYLINE ==========
;;;; auto conevt 2 pl
(defun c:atc (/ ss ss1 ss2 l tt e0 l1 t1 e1 co)
(command "UNDO" "Group")
(setq co (getstring "Do you want to joint 2D LINE [y/n]:" ))
(if (= (strcase co nil) "Y") (progn

(ltopl)
(setq ss (ssget "X" '((0 . "POLYLINE" ) ) ))
(if ss (progn
(setq ss1 ss)
(setq l (sslength ss))
(setq tt 0)
(repeat l
(setq e0 (ssname ss tt))
(setq tt (+ tt 1))
(if (and (entget e0) (> (sslength ss1) 0) ) (progn
(command "PEDIT" e0 "J" ss1 "" "")
))
(setq ss1 (locss ss1))
)
))
))
(command "UNDO" "end")
)
;;;; auto conevt 2 Line
(defun ltopl (/ ss ss1 ss2 l tt e0 l1 t1 e1 eg p1 p2)
(setq ss (ssget "X" '((0 . "LINE" ) ) ))
(if ss (progn
(setq ss1 ss)
(setq l (sslength ss))
(setq tt 0)
(repeat l
(setq e0 (ssname ss tt))
(setq tt (+ tt 1))
(setq eg (entget e0))
(setq p1 (cdr (assoc 10 eg) ))
(setq p2 (cdr (assoc 11 eg) ))
(if (= (nth 2 p1) (nth 2 p2))
(command "PEDIT" e0 "Y" "" )
)
)
))
:leluoi:)
)
;;-----------------------------------
(defun locss (ss1 / ss2 l1 t1 e1)
(if ss1 (progn
(setq l1 (sslength ss1))
(setq t1 0)
(setq ss2 (ssadd) )
(repeat l1
(setq e1 (ssname ss1 t1))
(setq t1 (+ t1 1))
(if (entget e1) (setq ss2 (ssadd e1 ss2) ))
)
))
(setq ss1 ss2)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


  • 0

#30 dovananh.xd

dovananh.xd

    biết lệnh offset

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

Đã gửi 07 October 2011 - 02:55 PM

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

Bác ơi, bác có thể kiểm tra lại cái lisp này không? nó bị lỗi thế này: khi viết một đoạn text bằng lệnh DT hoặc bất cứ cái gì liên quan đến góc như: Rotation, Obliquing, ... Cụ thể hơn: khi bản vẽ chưa app lisp này vào thì khi click vào đoạn text DT và bấm Ctrl +1 thì các thông số:
Contents: Giúp em với
Style: .VnArialNarrow
Annotative: No
Justify: Left
Height: 1.5
Rotation: 0
Width factory: 1.000
Obliquing: 0
...
Nhưng sau khi sử dụng lisp này thì:

Contents: Giúp em với
Style: .VnArialNarrow
Annotative: No
Justify: Left
Height: 1.5
Rotation: 90
Width factory: 1.000
Obliquing: 90
...
Tại sao lại thế và sửa lại lisp như thế nào?
Xin cám ơn!
  • 0

#31 dovananh.xd

dovananh.xd

    biết lệnh offset

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

Đã gửi 07 October 2011 - 04:15 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)
)

Bác ơi, bác có thể kiểm tra lại cái lisp này không? nó bị lỗi thế này: khi viết một đoạn text bằng lệnh DT hoặc bất cứ cái gì liên quan đến góc như: Rotation, Obliquing, ... Cụ thể hơn: khi bản vẽ chưa app lisp này vào thì khi click vào đoạn text DT và bấm Ctrl +1 thì các thông số:
Contents: Giúp em với
Style: .VnArialNarrow
Annotative: No
Justify: Left
Height: 1.5
Rotation: 0
Width factory: 1.000
Obliquing: 0
...
Nhưng sau khi sử dụng lisp này thì:

Contents: Giúp em với
Style: .VnArialNarrow
Annotative: No
Justify: Left
Height: 1.5
Rotation: 90
Width factory: 1.000
Obliquing: 90
...
Tại sao lại thế và sửa lại lisp như thế nào?
Xin cám ơn!
  • 0

#32 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 07 October 2011 - 04:27 PM

Theo mình thì cứ dùng cái lisp rải nhóm đồi tượng theo đường dẩn của mình thì rải được tất các kiểu taluy. Đầu vào là các nét taluy các bác cứ thay đổi thoải mái theo ý thích. Có quay hay không cũng theo ý thích thích dài ngắn thì rải nhiều lần, chọn điểm đầu phù hợp.
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#33 dovananh.xd

dovananh.xd

    biết lệnh offset

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

Đã gửi 07 October 2011 - 05:03 PM

Bạn nói thế cũng đúng, nhưng vấn đề ở đây là đã có người đưa ra được cái lisp này thì chắc chắn phải có cách khắc phục được nó và cho ra một phiên bản mới tốt hơn. Cái mình cần là cái đấy cơ. HIHI;))
  • 0

#34 SoftvnBin

SoftvnBin

    biết vẽ ellipse

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

Đã gửi 02 July 2012 - 04:47 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")
)

Nhờ các bác chỉnh sửa lại lisp giúp em các vấn đề sau:

1. Lưu số liệu lần nhập trước
2. Sau khi kết thúc lệnh bằng Enter (Undo/Change &lt;enter for exit&gt;) thì tự đóng block đối tượng vừa sinh ra với tên block cho nhập mới vào (với layer hiện hành)
3. Kết thúc bằng Enter không thực hiện tiếp lệnh VTL1
4. Khắc phục nill khi kết thúc lệnh Enter
5. Khi thực hiện lệnh [ Undo/Change <enter for exit>: *Cancel* ] để thay đổi phía rải taluy, không hỏi lại các tham số nữa mà thực hiện luôn
6. Khắc phục không đổi lệnh VLT1 thành lệnh khác được (giả sử thành lệnh VTL) (em thấy các lisp khác đổi lệnh được thông qua ký tự C:LLL thành tên lệnh mong muốn)
6. Khắc phụ lỗi không rải taluy hết đường và không vuông góc với đường như hình:Hình đã gửi
  • 0

#35 hotanphi

hotanphi

    biết vẽ polygon

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

Đã gửi 03 July 2012 - 01:31 PM

Mình thấy lisp của bạn thật hay. Tuy nhiên khi rải taluy thì nếu mình chọn vào đường cần rải thì nó sẽ rải hết đường đó. Tuy nhiên có 1 điều là ví dụ như đường mình cần rải ta luy là đường Polyline rất dài nhưng mình chỉ cần rải 1 đoạn trên đường Polyline này (Ví dụ từ A->B chẳng hạng).
Rất mong mấy anh em viết thêm đoạn code để mình có thể chọn vị trí rải theo kiểu: Chọn đường cần
rải taluy
-> pick chọn đường đó. " Vị trí bắt đầu rải taluy->pick trên đường cần rải taluy; Vị trí kết thúc rải taluy-> pick lên đường rải ta luy điểm này. Nếu ta pick các điểm bắt đầu rải và kết thúc rải không thuộc đường cần rải taluy mình chọn ban đầu thì lisp sẽ hỏi pick lại đến khi pick đúng.
Khi đó lisp chỉ rải trên đoạn mình vừa chọn.
Cái này mình thấy anh Duy đã viết cho cái lisp " Rải đối tượng theo đường dẫn".
và đầy là lisp của anh Duy đã viết để rải đối tượng theo đường dẫn

http://www.cadviet.c...g_chuan_rtd.lsp
Rất mong các anh giúp đỡ
  • 0

#36 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 03 July 2012 - 10:26 PM

Nhờ các bác chỉnh sửa lại lisp giúp em các vấn đề sau:

1. Lưu số liệu lần nhập trước
2. Sau khi kết thúc lệnh bằng Enter (Undo/Change &lt;enter for exit&gt;) thì tự đóng block đối tượng vừa sinh ra với tên block cho nhập mới vào (với layer hiện hành)
3. Kết thúc bằng Enter không thực hiện tiếp lệnh VTL1
4. Khắc phục nill khi kết thúc lệnh Enter
5. Khi thực hiện lệnh [ Undo/Change <enter for exit>: *Cancel* ] để thay đổi phía rải taluy, không hỏi lại các tham số nữa mà thực hiện luôn
6. Khắc phục không đổi lệnh VLT1 thành lệnh khác được (giả sử thành lệnh VTL) (em thấy các lisp khác đổi lệnh được thông qua ký tự C:LLL thành tên lệnh mong muốn)
6. Khắc phụ lỗi không rải taluy hết đường và không vuông góc với đường như hình:

Hề hề hề,
1/- Đã sửa
2/- Đã sửa
3/- Đã sửa
4/- Đã sửa
5/- Đã sửa.
6.1/- Không sửa. Nếu bạn muốn vậy hãy nhét lisp này vào file vlx.
6.2 a/- Đã sửa
6.2 b/- Không sửa vì lisp này sử dụng vẽ nét taluy vuông góc với đường nối hai điểm chân taluy chứ không phải vuông góc với đường rải ta luy. Nếu bạn muốn vậy thì cần làm lisp theo giải thuật khác.
Nếu mình đoán không sai thì lisp này là của bác Duy. Mạn phép bác chỉnh sửa một chút cho bạn SoftvnBin xài thử

Đây là cái đã sửa, bạn dùng thử nhé và cho ý kiến để mình hoàn thiện thêm.



;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1
(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 ()
(if (not ktdoantaluy1)
(setq ktdoantaluy1 250 tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
)
(if tg
(setq ktdoantaluy1 tg tg nil)
)
(if (not ktdoantaluy2)
(setq ktdoantaluy2 500 tg (getreal (strcat "\nChieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
)
(if tg
(setq ktdoantaluy2 tg tg nil)
)
(if (not khoangcachtl)
(setq khoangcachtl 200 tg (getreal (strcat "\nKhoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
)
(if tg
(setq khoangcachtl tg tg nil)
)
(if (not sodoanngan)
(setq sodoanngan 1 tg (getint (strcat "\nSo doan ngan trong 1 doan dai<" (rtos sodoanngan 2 0) ">:")))
)
(if tg
(setq sodoanngan tg tg nil)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 sodoan 0)
(setq ss (ssadd))
(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 dsd (append dsd (list (vlax-curve-getstartpoint (car ep)))))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
(setq ss (ssadd (entlast) ss))
)
)
)
(setq dem dem)
)

;;;==================================================
(Defun C:VTL1 (/ ep chon lai solan chon ss tg)
(vl-load-com)
(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")
)
(setq blname (getstring t "\n Nhap ten block ban muon: "))
(if (/= blname "")
(command "block" blname (list 0.0 0.0 0.0) ss "")
)
(setq ep nil)
)
)
)
(command "undo" "e")
(princ)
)

Hề hề hề,
Cách dùng lisp này vẫn u như kỵ, chỉ lưu ý khi lisp yêu cầu nhập tên block, nếu bạn không muốn tạo block thì chỉ cần nhấn enter để bỏ qua.
Chúc bạn vui.

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 04 July 2012 - 11:28 AM
Sửa lỗi lisp

  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#37 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 03 July 2012 - 11:56 PM

Mình thấy lisp của bạn thật hay. Tuy nhiên khi rải taluy thì nếu mình chọn vào đường cần rải thì nó sẽ rải hết đường đó. Tuy nhiên có 1 điều là ví dụ như đường mình cần rải ta luy là đường Polyline rất dài nhưng mình chỉ cần rải 1 đoạn trên đường Polyline này (Ví dụ từ A->B chẳng hạng).
Rất mong mấy anh em viết thêm đoạn code để mình có thể chọn vị trí rải theo kiểu: Chọn đường cần
rải taluy-> pick chọn đường đó. " Vị trí bắt đầu rải taluy->pick trên đường cần rải taluy; Vị trí kết thúc rải taluy-> pick lên đường rải ta luy điểm này. Nếu ta pick các điểm bắt đầu rải và kết thúc rải không thuộc đường cần rải taluy mình chọn ban đầu thì lisp sẽ hỏi pick lại đến khi pick đúng.
Khi đó lisp chỉ rải trên đoạn mình vừa chọn.
Cái này mình thấy anh Duy đã viết cho cái lisp " Rải đối tượng theo đường dẫn".
và đầy là lisp của anh Duy đã viết để rải đối tượng theo đường dẫn

http://www.cadviet.c...g_chuan_rtd.lsp
Rất mong các anh giúp đỡ

Hề hề hề,
Bạn dùng thủ cái mình sửa này coi có ưng không nhé


;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1
(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 250 tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))

(if tg
(setq ktdoantaluy1 tg)
)

(setq ktdoantaluy2 500 tg (getreal (strcat "\nChieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))

(if tg
(setq ktdoantaluy2 tg)
)

(setq khoangcachtl 200 tg (getreal (strcat "\nKhoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))

(if tg
(setq khoangcachtl tg)
)

(setq sodoanngan 1 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 d1 (vlax-curve-getdistatpoint (car ep) (vlax-curve-getclosestpointto (car ep) (getpoint "\n Chon diem bat dau rai taluy")))
d2 (vlax-curve-getdistatpoint (car ep) (vlax-curve-getclosestpointto (car ep) (getpoint "\n Chon diem ket thuc rai taluy")))
)
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(if (or (and (<= d1 (vlax-curve-getdistatpoint (car ep) p1)) (>= d2 (vlax-curve-getdistatpoint (car ep) p1)))
(and (<= d2 (vlax-curve-getdistatpoint (car ep) p1)) (>= d1 (vlax-curve-getdistatpoint (car ep) p1))) )
(ve1doantaluy p1 p2)
)
(setq p1 p2)

)
)
)
(setq dem dem)
)

;;;==================================================
(Defun C:VTL1 (/ ep chon lai solan chon ss tg)
(vl-load-com)
(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")
(princ)
)
Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#38 SoftvnBin

SoftvnBin

    biết vẽ ellipse

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

Đã gửi 04 July 2012 - 08:01 AM

Hề hề hề,
1/- Đã sửa
2/- Đã sửa
3/- Đã sửa
4/- Đã sửa
5/- Đã sửa.
6.1/- Không sửa. Nếu bạn muốn vậy hãy nhét lisp này vào file vlx.
6.2 a/- Đã sửa
6.2 b/- Không sửa vì lisp này sử dụng vẽ nét taluy vuông góc với đường nối hai điểm chân taluy chứ không phải vuông góc với đường rải ta luy. Nếu bạn muốn vậy thì cần làm lisp theo giải thuật khác.
Nếu mình đoán không sai thì lisp này là của bác Duy. Mạn phép bác chỉnh sửa một chút cho bạn SoftvnBin xài thử

Đây là cái đã sửa, bạn dùng thử nhé và cho ý kiến để mình hoàn thiện thêm.



;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl1 ()
(if (not ktdoantaluy1)
(setq ktdoantaluy1 250 tg (getreal (strcat "\nChieu dai doan ngan<" (rtos ktdoantaluy1 2 2) ">:")))
)
(if tg
(setq ktdoantaluy1 tg)
)
(if (not ktdoantaluy2)
(setq ktdoantaluy2 500 tg (getreal (strcat "\nChieu dai doan dai<" (rtos ktdoantaluy2 2 2) ">:")))
)
(if tg
(setq ktdoantaluy2 tg)
)
(if (not khoangcachtl)
(setq khoangcachtl 200 tg (getreal (strcat "\nKhoang cach giua cac doan<" (rtos khoangcachtl 2 2) ">:")))
)
(if tg
(setq khoangcachtl tg)
)
(if (not sodoanngan)
(setq sodoanngan 1 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 sodoan 0)
(setq ss (ssadd))
(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 dsd (append dsd (list (vlax-curve-getstartpoint (car ep)))))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
(setq ss (ssadd (entlast) ss))
)
)
)
(setq dem dem)
)

;;;==================================================
(Defun C:VTL1 (/ ep chon lai solan chon ss tg)
(vl-load-com)
(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")
)
(setq blname (getstring t "\n Nhap ten block ban muon: "))
(if (/= blname "")
(command "block" blname (list 0.0 0.0 0.0) ss "")
)
(setq ep nil)
)
)
)
(command "undo" "e")
(princ)
)

Hề hề hề,
Cách dùng lisp này vẫn u như kỵ, chỉ lưu ý khi lisp yêu cầu nhập tên block, nếu bạn không muốn tạo block thì chỉ cần nhấn enter để bỏ qua.
Chúc bạn vui.

Cảm ơn phamthanhbinh đã giúp mình, nhưng bị lỗi, bạn xem giúp mình nhé:

Command: vtl1

Chon doi tuong ve ta luy...
Chieu dai doan ngan<250.00>:25
Chieu dai doan dai<500.00>:50
Khoang cach giua cac doan<200.00>:20
So doan ngan trong 1 doan dai<1>:
; error: bad argument type: numberp: nil

Khi thuc hien lai lenh

Command: vtl1
Chon doi tuong ve ta luy...; error: bad argument type: numberp: nil
  • 0

#39 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 04 July 2012 - 10:50 AM

Cảm ơn phamthanhbinh đã giúp mình, nhưng bị lỗi, bạn xem giúp mình nhé:

Command: vtl1

Chon doi tuong ve ta luy...
Chieu dai doan ngan<250.00>:25
Chieu dai doan dai<500.00>:50
Khoang cach giua cac doan<200.00>:20
So doan ngan trong 1 doan dai<1>:
; error: bad argument type: numberp: nil

Khi thuc hien lai lenh

Command: vtl1
Chon doi tuong ve ta luy...; error: bad argument type: numberp: nil

Hề hề hề,
Xin lỗi bạn vì mình chưa test kỹ.
Bạn down lại lisp từ bài trước,(mình đã sửa rồi) để test lại nhé.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#40 hotanphi

hotanphi

    biết vẽ polygon

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

Đã gửi 04 July 2012 - 10:52 AM

Dạ em xin cảm ơn anh phamthanhbinh
Chúc anh và cả nhà sức khỏe.
Nhân đây anh cho em hỏi để post bài mới mình vào chỗ nào vậy anh.
Thực sự em đã vào diễnn đàn để xem cách post bài mới nhưng em không tìm thấy nút post image đâu cả.
Rất mong anh chỉ giúp em.
Xin chân thành cảm ơn anh em
  • 0