[Nhờ sửa lisp] vẽ taluy

[huunhantvxdts 195]

đây là lisp mình tìm trên mạng đã sữa lại theo những gì mình muốn nhưng còn một số chỗ chưa sữa được mong mọi người sữa lại giùm

những yêu cầu sau:

1. Có thể undo lại khi vẽ thấy taluy không hợp lí:

- Thay đổi khoảng cách giữa các vạch ngắn dài

- Thay đổi chiều đánh taluy

2. Có chọn điểm bắt đầu và điểm kết thúc ( bỡi trên đường mình chọn chỉ muốn đánh 1 đoạn nào đó)

sau đây là đoạn lisp:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=5947
;;; ======================== VE DUONG TALUY - LENH B1 (BATTER) =========================
;;; ================================================================================
=======
;; ============================================= 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 "\nKhoang cach giua vach ngan - vach dai <" (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 "\nChon duong thu nhat: "))
  (command "undo" "group")
  (redraw (car refent) 3)
  (initget 1 "Dao Mai")
  (setq reply (getkword "\nMai [D]ao or [M]ai dap: "))
  (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 "Mai")
 	(if (= (rem cn 2) 0)
 	(progn
 	(command "-layer" "set" "canh dai" "")
 	(command "line" pt1 pt2 "")
 	)
 	(progn
 	(command "-layer" "set" "canh ngan" "")
 	(command "line" pt1 (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)) "")
 	)
 	)
 	(if (= (rem cn 2) 0)
 	(progn
 	(command "-layer" "set" "canh dai" "")
 	(command "line" pt2 pt1 "")
 	)
 	(progn
 	(command "-layer" "set" "canh ngan" "")
 	(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)
(command "-layer" "new" "canh dai" "color" "8" "canh dai" "")
(command "-layer" "new" "canh ngan" "color" "2" "canh ngan" "")
;(command "-layer" "set" "canh dai" "")
(setvar "osmode" 0)
(c:batter)
(setvar "blipmode" 0)
(setvar "osmode" 167)
)