Chatbox

Các bạn vui lòng dùng từ ngữ lịch sự và có văn hóa,sử dụng Tiếng Việt có dấu chuẩn. Chúc các bạn vui vẻ!
11/04/2018 13:04 # 1
nqlamdn
Cấp độ: 11 - Kỹ năng: 4

Kinh nghiệm: 17/110 (15%)
Kĩ năng: 19/40 (48%)
Ngày gia nhập: 01/09/2012
Bài gởi: 567
Được cảm ơn: 79
LISP vẽ taluy đào đắp đất


Copy trên mạng, các bạn chạy.

(defun c:taluy (/)
 (setvar "CMDECHO" 0)
 (setq osmode (getvar "osmode"))
 (setvar "osmode" 0)
 (setvar "unitmode" 0)
 (setvar "dimzin" 0)
 (setvar "blipmode" 0)
 (setvar "aunits" 0)
 (setvar "angbase" (/ pi 2))
 (setvar "angdir" 1)

 (if (not (tblsearch "layer" "BATTER"))
   (command "layer" "n" "BATTER" "color" "8" "BATTER" "s" "BATTER" \n)
   (command "layer" "s" "BATTER" \n)
 )

 (if (not lint)
   (setq lint 10.0)
 )
 (setq	int (getdist (strcat "\nNhap khoang cach chia taluy <"
		     (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 doi tuong can rai taluy : "))
   (command "undo" "group")
   (redraw (car refent) 3)
   (initget 1 "daO daP")
   (setq
     reply (getkword "\nChon kieu taluy Nen Da[O] hay Nen Da[P]: ")
   )
   (print "\n")
   (print "Chon cac doi tuong can 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 "daP")
      (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)
 (setvar "osmode" osmode)
 (princ)
)


-- Có công mài sắt, có ngày nên kim ---


 
17/08/2018 15:08 # 2
nhgiangxd
Cấp độ: 13 - Kỹ năng: 4

Kinh nghiệm: 65/130 (50%)
Kĩ năng: 31/40 (78%)
Ngày gia nhập: 01/09/2012
Bài gởi: 845
Được cảm ơn: 91
LISP vẽ taluy đào đắp đất


Trích:

Copy trên mạng, các bạn chạy.

A nghiên cứu rộng và sâu thế! Great! ^-^ Thêm nữa đi ạ!



 
Copyright© Đại học Duy Tân 2010 - 2024