lenhan
31/10/09, 09:40 AM
Bài này hay nên mình giới thiệu, hy vọng có ích cho các bạn
Tại đây sẽ tổng hợp các lisp phục vụ cho chuyên ngành Giao Thông. Các bạn có thể nêu yêu cầu (nêu rõ đầy đủ dữ liệu đầu vào, mong muốn kết quả, có thể minh họa bằng hình ảnh và file Cad là tốt nhất).
Đầu tiên là lisp: Số hóa đường đồng mức. Lệnh CDM -> sẽ cho ra 2 lựa chọn
+ Lựa chọn thứ nhất : Số hóa theo bước ( B ) sẽ giúp bạn số hóa 1 cách liên tục và nhanh
+Lựa chọn thứ hai : Số hóa theo Text cao độ có sẵn ( T ) sẽ giúp bạn đưa cao độ của đường Polyline cần số hóa theo Text có sẵn.
(defun C:CDM (/ cdo next dem)
(setq phuongan (I_KEY "\nChon kieu nhap (theo Buoc lien tuc/theo Text co san)" "B T" phuongan))
(cond ( (= phuongan "B")
(setq cdo (I_REAL "\n Nhap cao do ban dau" cdo)
ccao (I_REAL "\n Nhap chenh cao giua cac duong dong muc" ccao)
insT (I_KEY "\nCo insert Text vao duong dong muc khong? <Yes,No>" "Y N" insT)
next (strcat "dau tien (cao do la: " (rtos cdo 2 2) ")")
dem 0
)
(if (and (= insT "Y") (null Tmaucd))
(setq Tmaucd (entget (ssname (ES_TM "\nChon text mau...") 0)))
)
(while (setq pline (entsel (strcat "\n Chon duong dong muc " next)))
(if (and (or (= (cdr (assoc 0 (entget (car pline)))) "POLYLINE")
(= (cdr (assoc 0 (entget (car pline)))) "LWPOLYLINE")
)
(/= (cdr (assoc 8 (entget (car pline)))) "DM so hoa")
)
(progn
(cond ( (= (length (assoc 10 (entget (car pline)))) 4)
(setq tdN (R_POS (assoc 10 (entget (car pline))) (list 0.0 0.0 0.0 cdo) "z"))
(entmod (subst tdN (assoc 10 (entget (car pline))) (entget (car pline))))
)
( (= (length (assoc 10 (entget (car pline)))) 3)
(entmod (subst (cons 38 cdo) (assoc 38 (entget (car pline))) (entget (car pline))))
)
)
(entmod (subst (cons 8 "DM so hoa") (assoc 8 (entget (car pline))) (entget (car pline))))
(setq dem (1+ dem)
cdo (+ cdo ccao)
next (strcat "thu " (itoa dem) " (cao do la: " (rtos cdo 2 2) ") /An enter de ket thuc chon")
)
(command "osmode" 2)
(while (setq pos (getpoint "\nVi tri dat text/Enter de ket thuc..."))
(command "osmode" 1)
(setq p1 (getpoint "\nchon diem lay huong thu 1...")
p2 (getpoint "\nchon diem lay huong thu 2...")
ang (angle p1 p2)
pos (polar pos (+ ang (/ pi 2)) (/ (cdr (assoc 40 Tmaucd)) 3))
text (subst (cons 11 pos) (assoc 11 Tmaucd) Tmaucd)
text (subst (cons 50 ang) (assoc 50 text) text)
text (subst (cons 72 1) (assoc 72 text) text)
)
(entmake text)
(command "osmode" 2)
)
)
(alert "Chon lai!!! . Doi tuong ban vua chon khong phai la Polyline hoac da duoc so hoa")
)
)
)
( (= phuongan "T")
(while (and (not (prompt "\n Chon duong dong muc /Enter de ket thuc... " ))
(setq pline (if (setq ss (ssget '((-4 . "<OR") (0 . "POLYLINE") (0 . "LWPOLYLINE") (-4 . "OR>"))))
(ssname ss 0)
nil)
)
)
(setq cdo (V_T (ssname (ES_TM "\nChon Text chua cao do") 0)))
(if (and (or (= (cdr (assoc 0 (entget pline))) "POLYLINE")
(= (cdr (assoc 0 (entget pline))) "LWPOLYLINE")
)
(/= (cdr (assoc 8 (entget pline))) "DM so hoa")
)
(progn
(cond ( (= (length (assoc 10 (entget pline))) 4)
(setq tdN (R_POS (assoc 10 (entget (car pline))) (list 0.0 0.0 0.0 cdo) "z"))
(entmod (subst tdN (assoc 10 (entget (car pline))) (entget (car pline))))
)
( (= (length (assoc 10 (entget pline))) 3)
(entmod (subst (cons 38 cdo) (assoc 38 (entget pline)) (entget pline)))
)
)
(entmod (subst (cons 8 "DM so hoa") (assoc 8 (entget pline)) (entget pline)))
)
(alert "Chon lai!!! . Doi tuong ban vua chon khong phai la Polyline hoac da duoc so hoa")
)
)
)
)
(princ"\n Copyright by Nataca ....www.tailieukythuat.com")
)
;------------------------------------------
;;;NHAP KEY VAO
(defun I_KEY (dongnhac key Text)
(if (null Text)
(progn
(initget 1 key)
(getkword (strcat dongnhac " :"))
)
(progn
(cond
((progn
(initget key)
(getkword (strcat dongnhac " < " Text " >:"))
)
)
(T Text)
)
)
)
)
;;;NHAP GIA TRI LA SO THUC
(defun I_REAL (dongnhac Tso)
(if (null Tso)
(progn
(initget (+ 1 2))
(getdist (strcat dongnhac " <?>:"))
)
(progn
(cond
( (progn
(initget (+ 2))
(getdist (strcat dongnhac " < "(rtos Tso 2 5) " >:"))
)
)
(T Tso)
)
)
)
)
;------------------------------------------
;;; DOI TOA DO X HOAC Y HOAC Z
(defun R_POS (TdOld TdNew vtri / Tj x y z)
(cond ( (= vtri "x")
(setq Tj (car TdOld)
x (cadr TdNew)
y (caddr TdOld)
z (cadddr TdOld)
)
(list Tj x y z)
)
( (= vtri "y")
(setq Tj (car TdOld)
x (cadr TdOld)
y (caddr TdNew)
z (cadddr TdOld)
)
(list Tj x y z)
)
( (= vtri "z")
(setq Tj (car TdOld)
x (cadr TdOld)
y (caddr TdOld)
z (cadddr TdNew)
)
(list Tj x y z)
)
( (= vtri "Tj")
(setq Tj (car TdNew)
x (cadr TdOld)
y (caddr TdOld)
z (cadddr TdOld)
)
(list Tj x y z)
)
)
)
;------------------------------------------
;;;GIA TRI CUA DOI TUONG TEXT STRING
(defun V_T (ent)
(cond ( (= (type (read (cdr (assoc 1 (entget ent))))) 'INT)
(read (cdr (assoc 1 (entget ent))))
)
( (= (type (read (cdr (assoc 1 (entget ent))))) 'REAL)
(read (cdr (assoc 1 (entget ent))))
)
(T (alert (strcat " Ban da chon text " (cdr (assoc 1 (entget ent))) " khong phai la mot so!!!")))
)
)
;------------------------------------------
;;; CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM (dongnhac / ss)
(while (and (not (prompt dongnhac))
(not (setq ss (ssget
'((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT") (-4 . "OR>"))
)
)
)
)
)
ss
)
các bạn có thể yêu cầu lisp tại bạn nacata
link bài viết http://tailieukythuat.com/forum/index.php?showtopic=1050
Tại đây sẽ tổng hợp các lisp phục vụ cho chuyên ngành Giao Thông. Các bạn có thể nêu yêu cầu (nêu rõ đầy đủ dữ liệu đầu vào, mong muốn kết quả, có thể minh họa bằng hình ảnh và file Cad là tốt nhất).
Đầu tiên là lisp: Số hóa đường đồng mức. Lệnh CDM -> sẽ cho ra 2 lựa chọn
+ Lựa chọn thứ nhất : Số hóa theo bước ( B ) sẽ giúp bạn số hóa 1 cách liên tục và nhanh
+Lựa chọn thứ hai : Số hóa theo Text cao độ có sẵn ( T ) sẽ giúp bạn đưa cao độ của đường Polyline cần số hóa theo Text có sẵn.
(defun C:CDM (/ cdo next dem)
(setq phuongan (I_KEY "\nChon kieu nhap (theo Buoc lien tuc/theo Text co san)" "B T" phuongan))
(cond ( (= phuongan "B")
(setq cdo (I_REAL "\n Nhap cao do ban dau" cdo)
ccao (I_REAL "\n Nhap chenh cao giua cac duong dong muc" ccao)
insT (I_KEY "\nCo insert Text vao duong dong muc khong? <Yes,No>" "Y N" insT)
next (strcat "dau tien (cao do la: " (rtos cdo 2 2) ")")
dem 0
)
(if (and (= insT "Y") (null Tmaucd))
(setq Tmaucd (entget (ssname (ES_TM "\nChon text mau...") 0)))
)
(while (setq pline (entsel (strcat "\n Chon duong dong muc " next)))
(if (and (or (= (cdr (assoc 0 (entget (car pline)))) "POLYLINE")
(= (cdr (assoc 0 (entget (car pline)))) "LWPOLYLINE")
)
(/= (cdr (assoc 8 (entget (car pline)))) "DM so hoa")
)
(progn
(cond ( (= (length (assoc 10 (entget (car pline)))) 4)
(setq tdN (R_POS (assoc 10 (entget (car pline))) (list 0.0 0.0 0.0 cdo) "z"))
(entmod (subst tdN (assoc 10 (entget (car pline))) (entget (car pline))))
)
( (= (length (assoc 10 (entget (car pline)))) 3)
(entmod (subst (cons 38 cdo) (assoc 38 (entget (car pline))) (entget (car pline))))
)
)
(entmod (subst (cons 8 "DM so hoa") (assoc 8 (entget (car pline))) (entget (car pline))))
(setq dem (1+ dem)
cdo (+ cdo ccao)
next (strcat "thu " (itoa dem) " (cao do la: " (rtos cdo 2 2) ") /An enter de ket thuc chon")
)
(command "osmode" 2)
(while (setq pos (getpoint "\nVi tri dat text/Enter de ket thuc..."))
(command "osmode" 1)
(setq p1 (getpoint "\nchon diem lay huong thu 1...")
p2 (getpoint "\nchon diem lay huong thu 2...")
ang (angle p1 p2)
pos (polar pos (+ ang (/ pi 2)) (/ (cdr (assoc 40 Tmaucd)) 3))
text (subst (cons 11 pos) (assoc 11 Tmaucd) Tmaucd)
text (subst (cons 50 ang) (assoc 50 text) text)
text (subst (cons 72 1) (assoc 72 text) text)
)
(entmake text)
(command "osmode" 2)
)
)
(alert "Chon lai!!! . Doi tuong ban vua chon khong phai la Polyline hoac da duoc so hoa")
)
)
)
( (= phuongan "T")
(while (and (not (prompt "\n Chon duong dong muc /Enter de ket thuc... " ))
(setq pline (if (setq ss (ssget '((-4 . "<OR") (0 . "POLYLINE") (0 . "LWPOLYLINE") (-4 . "OR>"))))
(ssname ss 0)
nil)
)
)
(setq cdo (V_T (ssname (ES_TM "\nChon Text chua cao do") 0)))
(if (and (or (= (cdr (assoc 0 (entget pline))) "POLYLINE")
(= (cdr (assoc 0 (entget pline))) "LWPOLYLINE")
)
(/= (cdr (assoc 8 (entget pline))) "DM so hoa")
)
(progn
(cond ( (= (length (assoc 10 (entget pline))) 4)
(setq tdN (R_POS (assoc 10 (entget (car pline))) (list 0.0 0.0 0.0 cdo) "z"))
(entmod (subst tdN (assoc 10 (entget (car pline))) (entget (car pline))))
)
( (= (length (assoc 10 (entget pline))) 3)
(entmod (subst (cons 38 cdo) (assoc 38 (entget pline)) (entget pline)))
)
)
(entmod (subst (cons 8 "DM so hoa") (assoc 8 (entget pline)) (entget pline)))
)
(alert "Chon lai!!! . Doi tuong ban vua chon khong phai la Polyline hoac da duoc so hoa")
)
)
)
)
(princ"\n Copyright by Nataca ....www.tailieukythuat.com")
)
;------------------------------------------
;;;NHAP KEY VAO
(defun I_KEY (dongnhac key Text)
(if (null Text)
(progn
(initget 1 key)
(getkword (strcat dongnhac " :"))
)
(progn
(cond
((progn
(initget key)
(getkword (strcat dongnhac " < " Text " >:"))
)
)
(T Text)
)
)
)
)
;;;NHAP GIA TRI LA SO THUC
(defun I_REAL (dongnhac Tso)
(if (null Tso)
(progn
(initget (+ 1 2))
(getdist (strcat dongnhac " <?>:"))
)
(progn
(cond
( (progn
(initget (+ 2))
(getdist (strcat dongnhac " < "(rtos Tso 2 5) " >:"))
)
)
(T Tso)
)
)
)
)
;------------------------------------------
;;; DOI TOA DO X HOAC Y HOAC Z
(defun R_POS (TdOld TdNew vtri / Tj x y z)
(cond ( (= vtri "x")
(setq Tj (car TdOld)
x (cadr TdNew)
y (caddr TdOld)
z (cadddr TdOld)
)
(list Tj x y z)
)
( (= vtri "y")
(setq Tj (car TdOld)
x (cadr TdOld)
y (caddr TdNew)
z (cadddr TdOld)
)
(list Tj x y z)
)
( (= vtri "z")
(setq Tj (car TdOld)
x (cadr TdOld)
y (caddr TdOld)
z (cadddr TdNew)
)
(list Tj x y z)
)
( (= vtri "Tj")
(setq Tj (car TdNew)
x (cadr TdOld)
y (caddr TdOld)
z (cadddr TdOld)
)
(list Tj x y z)
)
)
)
;------------------------------------------
;;;GIA TRI CUA DOI TUONG TEXT STRING
(defun V_T (ent)
(cond ( (= (type (read (cdr (assoc 1 (entget ent))))) 'INT)
(read (cdr (assoc 1 (entget ent))))
)
( (= (type (read (cdr (assoc 1 (entget ent))))) 'REAL)
(read (cdr (assoc 1 (entget ent))))
)
(T (alert (strcat " Ban da chon text " (cdr (assoc 1 (entget ent))) " khong phai la mot so!!!")))
)
)
;------------------------------------------
;;; CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM (dongnhac / ss)
(while (and (not (prompt dongnhac))
(not (setq ss (ssget
'((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT") (-4 . "OR>"))
)
)
)
)
)
ss
)
các bạn có thể yêu cầu lisp tại bạn nacata
link bài viết http://tailieukythuat.com/forum/index.php?showtopic=1050