Đến nội dung


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

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#3661 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 20 June 2011 - 11:42 PM

Cám ơn bác PhamThanhBinh đã sửa giúp và chỉ dẫn, cám ơn mọi người
Lisp chay rất tốt, rất đúng yêu cầu...
Chúc mọi người vui, khỏe, mong Chủ đề và diễn đàn luôn phát triển.
(Tiện đây cho em hỏi làm sao add được tên như sau: "phamthanhbinh, on 19 June 2011 - 09:49 PM, said:" lên tiêu đề của phần trích dẫn ?)

Hề hề hề,
Lisp chạy tốt nhưng chửa ngon đâu. Nếu bạn bỏ cái hàm (cond .....) đi được mới ngon cơ. Với khả năng của bạn, mình nghĩ bạn dư sức làm điều đó mà.
Muốn Add cái đó lên thì bạn chỉ cần click vào nút trả lời phía dưới cái bài viết bạn trích là OK mà.
Hề hề hế,...
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3662 lenhatanh

lenhatanh

    biết vẽ polygon

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

Đã gửi 21 June 2011 - 09:03 AM

Hề hề hề,
Lisp chạy tốt nhưng chửa ngon đâu. Nếu bạn bỏ cái hàm (cond .....) đi được mới ngon cơ. Với khả năng của bạn, mình nghĩ bạn dư sức làm điều đó mà.
Muốn Add cái đó lên thì bạn chỉ cần click vào nút trả lời phía dưới cái bài viết bạn trích là OK mà.
Hề hề hế,...

Cám ơn Bác đã giúo đỡ và khích lệ... Em đang thử đây.
  • 0

#3663 lenhatanh

lenhatanh

    biết vẽ polygon

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

Đã gửi 21 June 2011 - 09:19 AM

Em nhờ các Bác sửa dùm em Lisp "Ve_MCN" địa hình (đã chỉnh sửa, chạy và vẽ được mặt cắt ngang ĐH)
nhưng yêu cầu sau khi nhập các điểm xong, xuất hiện lại hộp thoại (trước khi vẽ MCN) thì trên hộp thoại
thể hiện 03 listbox: "TT" - số điểm, "CD" - Cao độ điểm và "KC" - Khoảng cách giũa các điểm.
(hiện nay chưa thể hiện được)
Link đến các file: *.DCL, *.Lsp, *.avi...: http://www.mediafire...d893l266ptycwt3

;------------------------------------------
(defun Get_tt (/ g:tt)
(set_tile "error" "")
(setq g:tt (get_tile "tt"))
(setq tt g:tt)
)
;------------------------------------------
(defun Get_cd (/ g:cd)
(set_tile "error" "")
(setq g:cd (get_tile "cd"))
(setq cd g:cd)
)
;------------------------------------------
(defun Get_kc (/ g:kc)
(set_tile "error" "")
(setq g:kc (get_tile "kc"))
(setq kc g:kc)
)
;------------------------------------------
(defun Get_nd (/ filename)
(set_tile "error" "")
(setq filename (getfiled "Write Text to File" "C:/My Documents/" "dhn" 1))
(setq tfw filename)
)
;------------------------------------------
(defun Get_li()
(start_list "tt" 3)
(foreach ch1 ltt (add_list ch1))
(end_list)
(start_list "cd")
(foreach ch2 lcd (add_list (rtos ch2 2 2)))
(end_list)
(start_list "kc")
(foreach ch3 lkc (add_list (rtos ch3 2 2)))
(end_list)
(mode_tile "start" 0)
(start_dialog)
)
;----------------------------------------------------------------------------------------------------------
(defun nhapdiem (/ Tex en cd cdi kc di ldi ldii n i io hso E Eo total Ele Elist d1 d2 di1 di2 ldinew tfile)
(setq tfile (open tfw "w") ldi '() lcd '() lkc '() ltt '() tti 1)
(setq tbd (getreal "\n Tile Cua Binh Do: "))
(setq tim (getreal "\n Khoang Cach Tu Mep Den Tim Kenh: "))

(while
(setq di (getpoint "\n Pick point...(<Retern>to end) :"))
(setq ldi (cons di ldi) ltt (cons (itoa tti) ltt))
(command "color" 40 "donut" "0" "0.15" di "")
(initget 128 "G D T")
(if (not E) (setq E "T"))
(setq Eo (getkword "\n Enter or Select Text Elevations or Select Plyline (Go/Duong/<Text>) : "))
(if Eo (setq E Eo))
(cond
((= E "G")
(setq cdo (getreal "\n Cao Do Dau...<0.0>: "))
(setq chc (getreal "\n Chenh Cao Do...<0.5>: "))
(setq cd (atof cdo))
(setq cdi (getreal (strcat "\n Cao do...(<Retern>to end) <" cdo ">:")))
(if cdi
(progn
(setq cd cdi cdo (rtos (+ cdi (atof chc)) 2 2))
)
(setq cdo (rtos (+ (atof cdo) (atof chc)) 2 2))
)
(setq lcd (cons cd lcd))
(write-line (rtos cd 2 2) tfile)
)
((= E "T")
(prompt "\n Selec Elevation Texts...: ")
(setq Ele (ssget))
(setq total (- (sslength Ele) 1))
(while (>= total 0)
(setq Elist (entget (ssname Ele total)))
(cond
((= "TEXT" (cdr (assoc 0 Elist)))
(setq cd (atof (cdr (assoc 1 Elist))) lcd (cons cd lcd))
(write-line (rtos cd 2 2) tfile)
)
(T nil)
)
(setq total (1- total))
)
)
(T
(setq en (entget (car (entsel "\CHON DUONG DONG MUC"))))
(setq cd (cdr (assoc 39 en)) lcd (cons cd lcd))
(write-line (rtos cd 2 2) tfile)
)
)
(setq tti ( + tti 1))
)
(setq n (length ldi) ldi (reverse ldi) i 1 hso (/ tbd 1000.0) ldii ldi)
(while (< i n)
(setq d1 (nth 0 ldii) d2 (nth 1 ldii))
(setq kc (* (distance d1 d2) hso) lkc (cons kc lkc))
(write-line (rtos kc 2 2) tfile)
(setq i (+ i 1) ldii (cdr ldii))
)
(write-line (rtos tim 2 2) tfile)
(close tfile)
(setq lcd (reverse lcd) lkc (reverse lkc) ltt (reverse ltt))
(command "color" 6 "OSMODE" 0)
(setq n (length ldi) io 0
di1 (list (car (nth io ldi)) (cadr (nth 0 ldi)) (nth io lcd))
ldinew (cons di1 ldinew))
(command "PLINE" di1)
(while (< io n)
(setq di2 (list (car (nth (+ io 1) ldi)) (cadr (nth (+ io 1) ldi)))
ldinew (cons di2 ldinew))
(command di2)
(setq io (+ io 1))
)
(command "")
(setq ma (eval (cons 'MAX lcd)) mi (eval (cons 'MIN lcd)) mss (rtos (- mi 2.0) 2 0))
)
;*******************************************************************************************
(defun vemcn (/ tex a aa tiled tilen ms kcc li2 li22 cdd li1 li11 poin tfw
x xx d1 d2 lis1 lis2 ld1 ld2 total k1 k2 to tot tota tee teee)
(setq d1 nil k1 nil k2 nil di nil total nil to nil tot nil tota nil tee nil teee nil)
(initget 32)
(setq tex (getvar "textsize") a (* 6.0 tex) aa (* 3.0 tex))
(setq tvd (getreal "\n Tile Dung Ve MCN: "))
(setq tvn (getreal "\n Tile Ngang Ve MCN: "))
(setq tiled (/ 1000.0 tvd) tilen (/ 1000.0 tvn) ms (atof mss))
(setq kcc (reverse lkc))
(while kcc
(setq li2 (cons (* (nth 0 kcc) tilen) li2))
(setq kcc (cdr kcc))
)
(setq li22 (cons 0 li2) cdd (reverse lcd))
(while cdd
(setq li1 (cons (* (- (nth 0 cdd) ms) tiled) li1))
(setq cdd (cdr cdd))
)
(setq li11 (reverse li1))
(COMMAND "LUPREC" 4 "COLOR" 8 "osnap" "None" "PLINETYPE" 1)

(setq poin (getpoint "\n Start point... : "))
(setq x (car poin) li11 li1 li22 (cons 0 li2) n (length lkc) i 1
ld1 nil ld2 nil lis1 nil lis2 nil)
(while (<= i n)
(setq d1 (list x (+ (cadr poin) (nth 0 li11))))
(setq xx (nth 1 li22))
(setq d2 (list (+ x xx) (+ (cadr poin) (nth 1 li11))))
(setq ld1 (cons d1 ld1) ld2 (cons d2 ld2))
(setq li22 (cdr li22) x (+ x (nth 0 li22)))
(setq li11 (cdr li11) i (+ i 1))
)
(command "line" poin (setq d1 (polar poin (/ pi 2) (nth 0 li1))) "")
(setq lis1 (reverse ld1) lis2 (reverse ld2))
(command "color" 3)
(mapcar '(lambda (pt1 pt2) (command ".Pline" pt1 pt2 "")) lis1 lis2)
(COMMAND "COLOR" 7)
(setq total (eval (cons + li2)))
(setq k1 (polar poin (- (/ pi 2)) a))
(setq k2 (polar k1 (- (/ pi 2)) aa))
(command "line" poin (polar poin 0.0 total) "")
(command "color" 8 "line" k1 (polar k1 0.0 total) "")
(command "line" k2 (polar k2 0.0 total) "" "color" 7)
(command ".TEXT" (list (+ (car poin) 0.2)(+ (cadr poin) 0.2))
"0" (strcat "MSS: " (rtos ms 2 2)))
(setq li11 (reverse li1) li22 li2)
(command ".TEXT" "J" "MC" (setq tee (polar poin (- (/ pi 2)) (/ a 2)))
"90" (rtos (nth 0 lcd) 2 2))
(command "color" 8 "line" k1 k2 "")
(while li22
(setq to (nth 0 li22))
(command "copy" "L" "" k1 (polar k1 0.0 to))
(setq li22 (cdr li22))
)
(setq li22 (reverse li2) kcc (reverse lkc) cdd (reverse lcd))
(setq teee (polar tee (- (/ pi 2)) (+ (/ a 2) (/ aa 2))))
(while li22
(setq tot (eval (cons + li22)))
(setq tota (- (eval (cons + li22)) (/ (nth 0 li22) 2)))
(COMMAND "COLOR" 8)
(command "line" (setq di (polar poin 0.0 tot)) (polar di (/ pi 2) (nth 0 li11)) "")
(COMMAND "COLOR" 7)
(command ".TEXT" "J" "MC" (polar tee 0.0 tot) "90" (rtos (nth 0 cdd) 2 2))
(command ".TEXT" "J" "MC" (polar teee 0.0 tota) "0" (rtos (nth 0 kcc) 2 2))
(setq li11 (cdr li11) cdd (cdr cdd))
(setq li22 (cdr li22) kcc (cdr kcc))
)
)
;------------------------------------------------------------------------------------------
;----------------------------- Chuong trinh chinh -----------------------------------------
(defun C:Ve-MCN (/ gii mss cdo tt tti tk tim tfr tfw Nhim done datafile filename)

(if (= (getvar "cmdecho") 1) (setvar "cmdecho" 0))
(setq datafile nil filename nil ltt nil lkc nil lcd nil)

(setq gii (load_dialog "Ve_Mcn.dcl"))
(setq done 3)
(while (> done 1)
(if (not (new_dialog "vemcn" gii)) (exit))
(action_tile "tt" "(Get_tt)")
(action_tile "cd" "(Get_cd)")
(action_tile "kc" "(Get_kc)")

(action_tile "nd" "(Get_nd)(done_dialog 2)")
(action_tile "start" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq done (start_dialog))
(cond
((= done 1) (vemcn))
((= done 2) (nhapdiem)(Get_li))
)
);---dong while
(unload_dialog gii)
(command "color" "bylayer" "ortho" "on" "osmode" 33 "REDRAW")
)

  • 0

#3664 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 21 June 2011 - 02:39 PM

Hề hề hề,
Trước hết cám ơn bạn đã dùng lisp do mình viết.
Thứ nữa là việc còn lại một số đối tượng không xoay như bản vẽ bạn post là do các polyline của bạn khá phức tạp. Nó có thể có nhiều giao điểm với đường cắt chứ không phải chỉ có một giao điểm. Do vậy mình đã không xét tới trường hợp này. Để mình xét thêm rồi nếu được sẽ bổ sung sau.
Bạn cần lưu ý thêm với vái lisp của mình là khi lisp yêu cầu bạn Chon điểm tiếp theo thì bạn cứ việc chọn liên tục sao cho cái polyline mà bạn thấy nó tạo ra bao kín hoặc cắt qua các đối tượng bạn cần xoay. Khi bạn không chọn nữa nó sẽ tự động khép kín lại. Tất cả các đối tượng nằm trong hoặc trên polyline này sẽ được chọn với điều kiện toàn bộ vùng chọn đều thấy được trên màn hình.
Một lần nữa cám ơn phản hồi của bạn.

Đây là lisp mình đã bổ sung để đảm bảo cắt sạch các polyline. Bạn dùng thử xem sao nhé. Mình đả thử với bản vẽ 111_2 bạn gửi thì thấy ngon lành. Các trường hợp khác mong bạn test thêm.



(defun c:xbd (/ p0 pn en en0 en1 ssl ssp en2 en3 pc p p1 p2 pk plst pls ssq gq ans)
(vl-load-com)
(command "undo" "be")
(setq p0 (getpoint "\n Chon diem dau duong cat ")
pn (getpoint p0 "\n Chon diem cuoi duong cat "))
(command "line" p0 pn "")
(setq en0 (entlast)
ssl (ssget "X" (list (cons 0 "*LINE"))))
(ve0 ssl)
(setq ssp (acet-ss-to-list (ssget "F" (list p0 pn) (list (cons 0 "*LINE")))))
(foreach en2 ssp
(setq pls (acet-geom-intersectwith en0 en2 0))
(setq en en2)
(if pls
(foreach pc pls
(command "break" en pc "@")
(setq en (entlast))
)
)
)
(setq p (getpoint p0 "\n Chon phia can xoay"))
(command "offset" "1" en0 p "")
(setq en1 (entlast)
p1 (cdr (assoc 10 (entget en1)))
pk (cdr (assoc 11 (entget en1)))
)
(setq plst (list))
(setq plst (append (list p1) plst))
(command "pline"
(while p1
(setq p2 (getpoint p1 "\n Chon diem tiep theo"))
(if p2
(progn
(setq plst (append (list p2) plst))
(command p1 p2)
(setq p1 p2)
)
(progn
(setq plst (append (list pk) plst))
(command p1 pk )
(setq p1 nil)
)
)
)
)
(setq en3 (entlast))
(setq ssq (ssget "CP" plst))
(setq ans (getstring "\n Chon tam quay < A or B >: "))
(setq gq (getreal "\n Nhap goc quay theo do: "))
(command "copy" en0 "" p0 p0)
(if (= (strcase ans) "A")
(command "rotate" ssq (entlast) "" p0 gq)
(command "rotate" ssq (entlast) "" pn gq)
)
(command "erase" en1 en3 "")
(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ve0 (ss)
(defun suadinhPl(thongtin / index doituong doituongmoi toado)
(setq
doituong (assoc '38 thongtin)
doituongmoi (cons 38 0.)
)
(subst doituongmoi doituong thongtin)
)
(defun suadinh (thongtin / index doituong doituongmoi toado)
(setq thongtinmoi nil)
(foreach doituong thongtin
(if (and (>= (car doituong) 10)
(<= (car doituong) 36)
)
(setq doituongmoi
(list (car doituong)
(cadr doituong)
(caddr doituong)
0.0
)
)
(setq doituongmoi doituong)
)
(setq thongtinmoi (append thongtinmoi (list doituongmoi)))
)
(setq thongtinmoi thongtinmoi)
)
(defun tendoituong (ssdt /)
(cdr (assoc '0 (entget ssdt)))
)
;;---------------------------------------------
(setq tapdoituong ss
;;;;; (ssget)
sodt (sslength tapdoituong)
index 0
ta (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
(repeat sodt
(setq
ssdt (ssname tapdoituong index)
pt (* (/ (* index 1.0) sodt) 100.0)
index (1+ index)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
(if (or (= (tendoituong ssdt) "SPLINE")
(= (tendoituong ssdt) "LINE")
(= (tendoituong ssdt) "CIRCLE")
(= (tendoituong ssdt) "ARC")
(= (tendoituong ssdt) "POLYLINE")
(= (tendoituong ssdt) "ELLIPSE")
(= (tendoituong ssdt) "TEXT")
(= (tendoituong ssdt) "DIMENSION")
(= (tendoituong ssdt) "ATTDEF")
(= (tendoituong ssdt) "SOLID")
(= (tendoituong ssdt) "INSERT")
(= (tendoituong ssdt) "ATTRIB")
(= (tendoituong ssdt) "HATCH")
)
(progn
(setq thongtin (entget ssdt)
thongtin (suadinh thongtin)
)
(entmod thongtin)
)
)
(if (= (tendoituong ssdt) "LWPOLYLINE")
(progn
(setq thongtin (entget ssdt)
thongtin (suadinhPL thongtin)
)
(entmod thongtin)
)
)
(princ)
)
)


Hy vọng bạn vừa ý. Chú ý khi chọn điểm tạo polyline sao cho phù hợp với ý bạn nhé.


làm phiền bác giúp em chỗ này tý.
- khi chương trình yêu cầu nhập góc
+ người dùng nhập góc- nhập góc xong
ơ chổ này em muốn nhờ bác thêm giùm cho một đoạn nữa là ban đã ưng ý chúa
nếu chưa thì tiếp tục nhập vào góc mới chương trình xoay lại. giống như lệnh undo cad nhưng mà không undo lại toần bộ mà chỉ phần góc để xoay thôi. cảm ơn bác rất là nhiều
  • 0

#3665 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 21 June 2011 - 02:56 PM

Hề hề hề,
1/- Về cái lisp thứ nhất:
Khi lisp thông báo "Chon tap hop diem can thay dổi cao do" tức là bạn hiểu việc làm tiếp theo của bạn là phải chọn tập hợp các điểm mà bạn muốn thay đổi cao độ của nó. Khi bạn đọc xong thông báo và hiểu được mình cần làm gi thì bạn nhấn nút OK trên thông báo để tắt n1o đi và lisp tiếp tục chạy.
Khi lisp thông báo điểm chọn 1 là nhắc bạn phải chọn một điểm trên màn hình mà điểm đó là một đầu của ô chữ nhật sẽ bao quanh các đối tượng được chọn.
Khi lisp thông báo điểm chọn 2 là nhắc bạn chọn điểm mút thứ hai của ô chữ nhật sẽ bao quanh các đối tượng cần chọn.
Sau khi bạn đã chọn được hai điểm này thì lisp sẽ chọn tất cả các đối tượng nằm trong ô chữ nhật có đường chéo là đoạn thẳng nối hai điểm bạn vừa chọn, tất nhiên các đối tượng được chọn phải thỏa mãn điều kiện lọc của hàm SSget trong lisp.

Bác cứ cho chọn đối tượng kiểu bình thường í bác ạ nó dể chịu hơn cứ chọn kiểu gì thì chọn sau khi kết thúc chọn thì bác thực hiện lọc ra từ kết quả vừa chọn cho nó hay.
Kiểu như lọc text từ tập hợp vừa chọn thì như này này bác.
(setq SS (ssget "p" '((0 . "TEXT"))))
  • 1

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


#3666 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 21 June 2011 - 03:11 PM

làm phiền bác giúp em chỗ này tý.
- khi chương trình yêu cầu nhập góc
+ người dùng nhập góc- nhập góc xong
ơ chổ này em muốn nhờ bác thêm giùm cho một đoạn nữa là ban đã ưng ý chúa
nếu chưa thì tiếp tục nhập vào góc mới chương trình xoay lại. giống như lệnh undo cad nhưng mà không undo lại toần bộ mà chỉ phần góc để xoay thôi. cảm ơn bác rất là nhiều

Hề hề hề,
Bạn hãy bổ sung đoạn code sau :
(setq an1 (getstring "Ban da hai long??? <Y or N>: "))
(while (= (strcase an1) "N")
(command "undo" "1")
(setq gq (getreal "/n Nhap goc quay moi: "))
(if (= (strcase ans) "A")
(command "rotate" ssq (entlast) "" p0 gq)
(command "rotate" ssq (entlast) "" pn gq)
)
(setq an1 (getstring "\n Ban da hoan toan hai long <Y or N>: "))
)

vào ngay trên dòng code:
(command "erase" en1 en3 "")

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

#3667 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 21 June 2011 - 03:33 PM

Bác cứ cho chọn đối tượng kiểu bình thường í bác ạ nó dể chịu hơn cứ chọn kiểu gì thì chọn sau khi kết thúc chọn thì bác thực hiện lọc ra từ kết quả vừa chọn cho nó hay.
Kiểu như lọc text từ tập hợp vừa chọn thì như này này bác.
(setq SS (ssget "p" '((0 . "TEXT"))))

Hề hề hề,
Sở dĩ mình làm vầy là vì muốn sử dụng một vùng chọn cho cả hai tập đối tượng là tập psl và tsl bác Duy ạ. Như vậy sẽ hạn chế bớt được các đối tượng ngoại lai do hai vùng chọn khác nhau.
Cũng vì hai tập chọn này khác nhau nên không dùng với tham số p được.
Nếu muốn sử dụng như bác gợi ý thì sẽ phải làm thành ba tập chọn. Tập chọn thứ nhất là tất cả các đối tượng trong vùng chọn, tập chọn thứ hai là tập chọn chỉ gồm các point có trong tập chọn thứ nhất, tập chọn thứ 3 chỉ gồm các text trong tập chọn thứ nhất. Và các bước kế tiếp sẽ áp dụng với tập chọn thứ hai và tập chọn thứ ba bác nhể.
Để lisp chạy mát ga hơn, nhất là trong trường hợp vùng chọn lớn và số đối tượng cực nhiều thì mình đang nghĩ tới giải pháp lấy tập chọn tsl tùy theo mỗi point thuộc tập psl bác ạ. Như vậy lisp sẽ phóng một phát từ Sài gòn ra Quảng ngãi trong vài giây bác hỉ????
Hề hề hề,....
Bác thử xem cái ni mình đã sửa lại theo ý trên:


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=3840
(defun c:chgev (/ )
(vl-load-com)
(command "undo" "be")
(setq UC (getvar "ucsname"))
(command "ucs" "World")
(alert "\n Chon tap hop diem can thay doi cao do")
(setq psl (acet-ss-to-list (ssget (list (cons 0 "POINT")))))
;;;; (setq tsl (acet-ss-to-list (ssget "W" pt1 pt2 (list (cons 0 "TEXT")))))
(setq hs (getreal "\n Nhap hang so tinh toan: "))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(foreach p psl
(setq p0 (cdr (assoc 10 (entget p))))
(setq pt1 (list (- (car p0) 1) (- (cadr p0) 2)))
(setq pt2 (list (+ (car p0) 1) (+ (cadr p0) 2)))
(setq tsl (acet-ss-to-list (ssget "C" pt1 pt2 (list (cons 0 "TEXT")))))
(foreach txt tsl
(setq p1 (cdr (assoc 11 (entget txt))))
(if (= (cadr p1) (cadr p0))
(progn
(if (equal (- (car p0) (car p1)) 0.4 0.001)
(progn
(setq el1 (entget txt))
(setq t1 (cdr (assoc 1 el1)))
)
)
(if (equal (- (car p1) (car p0)) 0.4 0.001)
(progn
(setq el2 (entget txt))
(setq t2 (cdr (assoc 1 el2 )))
)
)
)
)
)
(if (and t1 t2)
(progn
(setq num (congtrunhanchia key_ctnc (atof (strcat t1 "." t2)) hs)) ;;;;;;;;;;;; (- (atof (strcat t1 "." t2)) hs))
(setq htxt (rtos num 2 2)
vt (vl-string-position (ascii ".") htxt)
t3 (substr htxt 1 vt)
t4 (substr htxt (+ vt 2))
el1 (subst (cons 1 t3) (assoc 1 el1) el1)
el2 (subst (cons 1 t4) (assoc 1 el2) el2)
)
(entmod el1)
(entmod el2)
)
)
)
(command "ucs" uc)
(command "undo" "e")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 21 June 2011 - 04:33 PM
Bổ sung thêm lisp đã chỉnh sửa

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

#3668 zizpo_hetxang

zizpo_hetxang

    biết vẽ arc

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

Đã gửi 21 June 2011 - 03:47 PM

Hề hề hề,
Bạn hãy bổ sung đoạn code sau :
(setq an1 (getstring "Ban da hai long??? <Y or N>: "))
(while (= (strcase an1) "N")
(command "undo" "1")
(setq gq (getreal "/n Nhap goc quay moi: "))
(if (= (strcase ans) "A")
(command "rotate" ssq (entlast) "" p0 gq)
(command "rotate" ssq (entlast) "" pn gq)
)
(setq an1 (getstring "\n Ban da hoan toan hai long <Y or N>: "))
)

vào ngay trên dòng code:
(command "erase" en1 en3 "")

Hy vọng đúng ý bạn.


tuyệt cú mèo rồi bác. cảm ơn
  • 0

#3669 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 21 June 2011 - 04:33 PM

trong lúc thiết kế em gặp phải vấn đề như sau :
1 ) em thiết kế lại độ dốc của cống cho phù hợp với đường tự nhiên mới . nhưng lại phải tính lại độ dốc 1 cách thủ công là vẽ đường ngang dài 100 và bê đường chéo của đọc dốc cần tính lại rồi đo diểm cuối của đường ngang và điển của đường chéo để tính độ dốc . nhờ các bác viết hộ em cái lip với cái ý tưởng như sau
:
+ kích vào độ dốc mới
+ kích vào text cần thay ( với font của cái độ dốc cũ )
+ nếu không có text thì kích vào điểm bất kỳ để tạo têxt

2 ) khi thiết kế xong mặt cắt ngang có những điểm mình cần tính cao độ nhưng phải làm bằng thủ công nên em muốn nhờ các bác viết hộ cái lip tính cao độ với ý tưởng như sau :
+ chọn điển gốc và nhập cao độ điểm đó
+ kick vào điểm cần tính cao độ
+ kick vào teext cần thay
+ nếu không có text thì kích vào điểm bất kỳ để tạo têxt
+ kick điểm tiếp theo
+ kick hết diểm ấn enter đẻ kết thúc lệnh

http://www.cadviet.com/upfiles/3/liptinhcaodovadodoc.dwg

thank các bác !
  • 0

#3670 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 21 June 2011 - 08:42 PM

trong lúc thiết kế em gặp phải vấn đề như sau :
1 ) em thiết kế lại độ dốc của cống cho phù hợp với đường tự nhiên mới . nhưng lại phải tính lại độ dốc 1 cách thủ công là vẽ đường ngang dài 100 và bê đường chéo của đọc dốc cần tính lại rồi đo diểm cuối của đường ngang và điển của đường chéo để tính độ dốc . nhờ các bác viết hộ em cái lip với cái ý tưởng như sau
:
+ kích vào độ dốc mới
+ kích vào text cần thay ( với font của cái độ dốc cũ )
+ nếu không có text thì kích vào điểm bất kỳ để tạo têxt

2 ) khi thiết kế xong mặt cắt ngang có những điểm mình cần tính cao độ nhưng phải làm bằng thủ công nên em muốn nhờ các bác viết hộ cái lip tính cao độ với ý tưởng như sau :
+ chọn điển gốc và nhập cao độ điểm đó
+ kick vào điểm cần tính cao độ
+ kick vào teext cần thay
+ nếu không có text thì kích vào điểm bất kỳ để tạo têxt
+ kick điểm tiếp theo
+ kick hết diểm ấn enter đẻ kết thúc lệnh

http://www.cadviet.com/upfiles/3/liptinhcaodovadodoc.dwg

thank các bác !

Hề hề hề,
Quả là có khoai thật. Bạn hãy suy nghĩ kỹ và trình bày thật mạch lạc cái vấn đề của bạn nhé. Mình đã đọc và đã xem cái bản vẽ bạn post lên mà vẫn chả hiểu bạn muốn gì nữa.
Này nhé: kích vào độ dốc mới là kích vào cái chi vậy??? vào text độ dốc hay vào cái đường có dộ dốc???
font của dộ dốc cũ là font chi vậy??? phải chăng bạn muốn nói cái text độ dốc mới có cùng font với text độ dốc cũ????
Cái cách tính cao độ của bạn là như thế nào?? Dựa vào tọa độ trên bản vẽ và tọa độ gốc của điểm gốc bạn chọn.
.......................
Hy vọng rằng bạn sẽ bổ sung thêm dăm điều kiện nữa để bài toán bạn đặt ra đỡ khoai hơn nhé....
Hề hề hề
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3671 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 21 June 2011 - 10:39 PM

Hề hề hề,
Quả là có khoai thật. Bạn hãy suy nghĩ kỹ và trình bày thật mạch lạc cái vấn đề của bạn nhé. Mình đã đọc và đã xem cái bản vẽ bạn post lên mà vẫn chả hiểu bạn muốn gì nữa.
Này nhé: kích vào độ dốc mới là kích vào cái chi vậy??? vào text độ dốc hay vào cái đường có dộ dốc???
font của dộ dốc cũ là font chi vậy??? phải chăng bạn muốn nói cái text độ dốc mới có cùng font với text độ dốc cũ????
Cái cách tính cao độ của bạn là như thế nào?? Dựa vào tọa độ trên bản vẽ và tọa độ gốc của điểm gốc bạn chọn.
.......................
Hy vọng rằng bạn sẽ bổ sung thêm dăm điều kiện nữa để bài toán bạn đặt ra đỡ khoai hơn nhé....
Hề hề hề

hihi đa tạ bác đã quan tâm . em đã viết lại mong muốn của mình rồi đây
http://www.cadviet.com/upfiles/3/bosungdieukien.dwg
mong bác giúp đỡ củ khoai hà này , cũng vì do kiến thức hạn hẹp , kỹ thuật lại yếu , muốn nhanh thì phải dung đến lip
thank bác nhiều .
  • 0

#3672 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 22 June 2011 - 01:29 AM

hihi đa tạ bác đã quan tâm . em đã viết lại mong muốn của mình rồi đây
http://www.cadviet.com/upfiles/3/bosungdieukien.dwg
mong bác giúp đỡ củ khoai hà này , cũng vì do kiến thức hạn hẹp , kỹ thuật lại yếu , muốn nhanh thì phải dung đến lip
thank bác nhiều .

Hề hề hề,
Vẫn còn chút khoai hà bạn ạ. Việc chọn điểm trên Cad để ghi ra cao độ không khó xong cách tính cái cao độ ấy ra sao thì mới có cái mà ghi chứ bạn...
Nếu chỉ là dựa vào tọa độ của điểm trên bản vẽ để so sánh với tọa độ của điểm mốc rồi ghi ra thì không khó song nó còn liên quan tới vấn đề gì khác nữa thì sao??? Tỷ như cái tỷ lệ của bản vẽ và cái cách nội suy cao độ chẳng hạn....
Hề hề hề, hãy suy nghĩ thêm bạn 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.

#3673 gasmanc

gasmanc

    biết vẽ line

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

Đã gửi 22 June 2011 - 07:29 AM

Hề hề hề,
Cách chạy lisp thứ nhất mình đã nói khá rõ rồi. bạn cứ chạy đúng như thế là Ok vì mình đã chạy thử với cả hai bản vẽ bạn pót lên rồi. Kết quả ngon
Nếu bạn vẫn chưa thông thì có thể dùng cái lisp mình đã sửa trong bài post số 3863 phía trên. Lisp mới này sẽ chạy nhanh hơn lisp trước nhất là khi vùng chọn có nhiều point.
Với lisp thứ hai, mình đang nghĩ cách giải quyết vấn đề khác với cách bạn nghĩ nhiều. Đó là chả nối hai thằng làm một làm gì mà ngược lại là chuyển từ hai text thành 3 text, tức là thêm một thằng cu text "." nữa và đặt thằng cu này vào trung cái point.
Vấn đề cộng trừ nhân chia chi đó thì đã giải quyết được trong lisp thứ nhất rồi.
Tuy nhiên cũng cần chút thời gian chứ chẳng thể có ngay cho bạn được.
Hề hề hề, hãy chịu khó đợi thêm chút nữa hỉ.....

Và đây là cái lisp chuyển các text về thẳng hàng dạng A.B thỏa mãn yêu cầu của bạn nhưng không phải là một text mà là bao gồm 3 text riêng biệt.Lisp này cũng thực hiện các phép tính với hằng số cho trước như lisp cũ và trả ra là kết quả đã được tính toán. Nếu bạn muốn giá trị cao độ không đổi thì nhập hằng số tính toán là 0 với phép tính là cộng hay trừ hoặc nhập hằng số tính toán là 1 với các phép tính là nhân hay chia.
Bạn hãy dùng thử và cho ý kiến nha.



;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=3840
(defun c:chgev (/ psl tsl hs key_ctnc1 key_ctnc p0 p1 el1 el2 t1 t2 t3 t4 ts htxt num vt )
(vl-load-com)
(command "undo" "be")
(setq UC (getvar "ucsname"))
(command "ucs" "World")
(alert "\n Chon tap hop diem can thay doi cao do")
(setq psl (acet-ss-to-list (ssget (list (cons 0 "POINT")))))
;;;; (setq tsl (acet-ss-to-list (ssget "W" pt1 pt2 (list (cons 0 "TEXT")))))
(setq hs (getreal "\n Nhap hang so tinh toan: "))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(foreach p psl
(setq p0 (cdr (assoc 10 (entget p))))
(setq pt1 (list (- (car p0) 1) (- (cadr p0) 2)))
(setq pt2 (list (+ (car p0) 1) (+ (cadr p0) 2)))
(setq tsl (acet-ss-to-list (ssget "C" pt1 pt2 (list (cons 0 "TEXT")))))
(foreach txt tsl
(setq p1 (cdr (assoc 11 (entget txt))))
(if (= (cadr p1) (cadr p0))
(progn
(if (equal (- (car p0) (car p1)) 0.4 0.001)
(progn
(setq el1 (entget txt))
(setq t1 (cdr (assoc 1 el1)))
)
)
(if (equal (- (car p1) (car p0)) 0.4 0.001)
(progn
(setq el2 (entget txt))
(setq t2 (cdr (assoc 1 el2 )))
)
)
)
)
)
(if (and t1 t2)
(progn
(entmake (list (cons 0 "text") (assoc 8 el2) (cons 10 p0) (cons 11 p0) (assoc 40 el2) (assoc 7 el2) (cons 1 ".") (cons 72 1)))
(setq ts (entlast))
(setq el2 (subst (cons 73 0) (assoc 73 el2) el2)
el2 (subst (cons 10 (cdr (assoc 11 el2))) (assoc 10 el2) el2))
(entmod el2)
(setq num (congtrunhanchia key_ctnc (atof (strcat t1 "." t2)) hs)) ;;;;;;;;;;;; (- (atof (strcat t1 "." t2)) hs))
(setq htxt (rtos num 2 2)
vt (vl-string-position (ascii ".") htxt)
t3 (substr htxt 1 vt)
t4 (substr htxt (+ vt 2))
el1 (subst (cons 1 t3) (assoc 1 el1) el1)
el2 (subst (cons 1 t4) (assoc 1 el2) el2)
)
(entmod el1)
(entmod el2)
)
)
)
(command "ucs" uc)
(command "undo" "e")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))
)
kq
)

Chúc bạn vui


cảm ơn bạn. Cách giải quyết vấn đề bằng cách cho thêm 1 text "." rất hay. Mình đã test thử. lisp chạy ngon. Mình cũng đã tìm ra nguyên nhân tại sao lisp 1 không chạy. Đó là do nó không làm việc trong cad 2005. Chạy trên bản 04 thì ok rồi.
chờ tin bạn hoàn thành lisp thứ 2. hì hì.
  • 0

#3674 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 22 June 2011 - 08:35 AM

Hề hề hề,
Vẫn còn chút khoai hà bạn ạ. Việc chọn điểm trên Cad để ghi ra cao độ không khó xong cách tính cái cao độ ấy ra sao thì mới có cái mà ghi chứ bạn...
Nếu chỉ là dựa vào tọa độ của điểm trên bản vẽ để so sánh với tọa độ của điểm mốc rồi ghi ra thì không khó song nó còn liên quan tới vấn đề gì khác nữa thì sao??? Tỷ như cái tỷ lệ của bản vẽ và cái cách nội suy cao độ chẳng hạn....
Hề hề hề, hãy suy nghĩ thêm bạn nhé.

http://www.cadviet.com/upfiles/3/bosungdieukien.dwg
anh có thể giúp em về phần độ dốc cái cống đã vì hiện tại em cần cái đó lắm. còn cái cao độ thì em đã nhờ bạn em viết 1 cái lip cũng đúng như mong muốn vì bạn em cũng đã từng gặp trường hợp như vậy nhưng cũng chỉ mò mẫm hay mót gì đó nên nó ko hoàn chỉnh . em đua code nó lên đây anh xem và rút gon cho em cái .
hoặc lược bỏ phần không cần thiết vì khi chạy nó thì nó chống với tất cả các lip khác mới đau em
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq sc 1)
(setvar "dimzin" 0)
(defun c:os () (setvar "osmode" 545))
;;;;;===============================
;; Silent load.
(princ)
(defun c:e1 () (command "erase" "all" ""))

(defun c:+++++ () (command "'.zoom" "8x"))
(defun c:++++++ () (command "'.zoom" "16x"))
(defun c:++++ () (command "'.zoom" "4x"))
(defun c:+++ () (command "'.zoom" "2x"))
(defun c:++ () (command "'.zoom" "1.5x"))
(defun c:+ () (command "'.zoom" "1.2x"))
(defun c:- () (command "'.zoom" "0.9x"))
(defun c:-- () (command "'.zoom" "0.5x"))
(defun c:--- () (command "'.zoom" "0.2x"))
(defun c:---- () (command "'.zoom" "0.1x"))
(defun c:----- () (command "'.zoom" "0.05x"))
(defun c:------ () (command "'.zoom" "0.01x"))
(defun c:1 () (ssget) (command "change" "p" "" "p" "c" "1" ""))
(defun c:2 () (ssget) (command "change" "p" "" "p" "c" "2" ""))
(defun c:3 () (ssget) (command "change" "p" "" "p" "c" "3" ""))
(defun c:4 () (ssget) (command "change" "p" "" "p" "c" "4" ""))
(defun c:5 () (ssget) (command "change" "p" "" "p" "c" "5" ""))
(defun c:6 () (ssget) (command "change" "p" "" "p" "c" "6" ""))
(defun c:7 () (ssget) (command "change" "p" "" "p" "c" "7" ""))
(defun c:8 () (ssget) (command "change" "p" "" "p" "c" "8" ""))
(defun c:9 () (ssget) (command "change" "p" "" "p" "c" "9" ""))
(defun c:10 () (ssget) (command "change" "p" "" "p" "c" "10" ""))
(defun c:11 () (ssget) (command "change" "p" "" "p" "c" "11" ""))
(defun c:0 () (ssget) (command "change" "p" "" "p" "c" "BY LAYER" ""))
;**********************************************************************
(defun c:goc ()
(setvar "cmdecho" 0)
;(setq osm (getvar "osmode"))
(if (= sc nil)(setq sc (getreal (strcat"\nChon ty le ve (=kt ve/kt Autocad):"))))
(prompt "\n*****Chu y: Ty le hien tai la*****:")(princ sc)
;(if (/= sc2 nil)(setq sc sc2))
(command ".zoom" "e")
;(setq sspl (SSGET "c" '(10.5 20.25) '(10.5 27.5) (LIST(CONS 0 "lwpolyline"))));su dung khi ban ve co 1 cn o toa do co dinh
;(if (= th nil) (setq th (ssget "w" '(10.5 19.25 0) '(11.5 18.00 0) (list(cons 0 "TEXT")))))
(command "zoom" "p")
(if (and (= a nil)(/= sspl nil))(setq a (cdr(assoc 10 (entget (ssname sspl 0))))))
(IF (= a nil)
(setq a (Getpoint "\n Chon mot diem lam chuan (co cao do):"))
(progn
(setq kitu nil)
(initget "Co Khong")
(setq kitu (getkword "\n Ban co chon lai diem chuan khong?[Co/Khong]:<K>"))
(If (= kitu "Co")(setq a (Getpoint "\n Chon lai diem lam chuan (co cao do):")))
)
)

;(if (and(= nil g)(/= nil th)) (setq g (atof (cdr (ASSOC 1 (ENTGET (SSNAME th 0)))))))
(IF (= nil g)
(progn
(prompt "Khong co cao do tai vi tri can tim!")
(setq g (Getreal "\n Nhap cao do diem chuan [Bang ban phim/Chon tren man hinh]:<Chon>" ))
(if (= nil g)
(progn
(setq sscd (entsel "\n Moi ban chon cao do tren man hinh:"))
(setq g (atof (cdr (assoc 1 (entget (car sscd))))))
(prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
)
)
)
(If(= kitu "Co")
(progn
(setq g (Getreal "\n Nhap lai cao do diem chuan [Bang ban phim/Chon tren man hinh]:<Chon>" ))
(if (= nil g)
(progn
(setq sscd (entsel "\n Moi ban chon lai cao do tren man hinh:"))
(setq g (atof (cdr (assoc 1 (entget (car sscd))))))
(prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:"))
)
)
)
)
)
)


;;============Tinh cao do khi biet cao do diem chon lam c:goc====================
(defun c:tcd ()
(PROMPT "\n(Lenh tinh toa do & K/C 1 diem bat ky)")
(c:goc)
(setq xa (* sc (car a)))
(setq ya (* sc (cadr a)))
(setq l1 xa)
(setq l3 ya)
(While
(setq b (Getpoint "\n Chon diem can tinh:"))
(setq xb (* sc (car B)))
(setq x (- xb xa))
(setq yb (* sc (cadr B)))
(setq y (+ g (- yb ya)))
(setq ypr (rtos y 2 3))
(setq l2 xb)
(setq l4 yb)
(setq dy (- l4 l3))
(setq l3 l4)
(setq l (- l2 l1))
(setq ypr1 (rtos L 2 3))
(setq l1 l2)
(Prompt "\nCao do diem vua chon:") (princ (rtos y 2 3))
(Prompt "\nK/C x le:") (princ (rtos l 2 3))
(Prompt " _ K/C x den diem goc:") (princ (rtos x 2 3))
(if (= 0 l)
(Prompt " _ Do doc doan vua chon: E%")
(Progn
(setq dd (* 100 (/ dy l)))
(Prompt " _ Do doc doan vua chon:")(princ (rtos dd 2 3))(princ "%")
)
)

;(setq pt2 (getpoint "\nDiem ghi cao do vua tinh duoc :"))
;(command "TEXT" pt2 "" "90" ypr)
;(setq pt3 (getpoint "\nDiem ghi K/C le vua tinh duoc :"))
;(command "TEXT" pt3 "" "90" ypr1)
;(setq a '(0 0 0) g 0)
(setq thchon (nentselp"\nChon text can thay the:"))
(if (/= nil thchon)
(progn
(setq ens (car thchon))
(COMMAND "CHANGE" ens "" "" "" "" "" ""(rtos y 2 2))
(COMMAND "CHANGE" ens "" "p" "c" "6" "")
)
)
(princ)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  • 0

#3675 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 22 June 2011 - 12:07 PM

cảm ơn bạn. Cách giải quyết vấn đề bằng cách cho thêm 1 text "." rất hay. Mình đã test thử. lisp chạy ngon. Mình cũng đã tìm ra nguyên nhân tại sao lisp 1 không chạy. Đó là do nó không làm việc trong cad 2005. Chạy trên bản 04 thì ok rồi.
chờ tin bạn hoàn thành lisp thứ 2. hì hì.

Hề hề hề,
Bạn chờ cái chi nữa nhỉ??? Với hai cái lisp mình đã gửi, nếu bạn chú ý khi dùng thì hoàn toàn có thể thỏa mãn cả 3 yêu cầu bạn đã đặt ra rồi.
Này nhé:
Với yêu cầu 1: Bạn chạy cái lisp thứ 2 nhưng khi lisp hỏi nhập hằng số tính toán thì bạn nhập 0 và chọn phép tính cộng là OK.
Với yêu cầu 2: Bạn chạy cái lisp thứ 2 và nhập hằng số tính toán, phép tính theo ý bạn là Ok
Với yêu cầu 3: Bạn chạy cái lisp thứ 1 là OK.

Vậy thì bạn còn chờ chi nữa mà không dùng thử chúng coi sao hỉ???
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3676 ponaparte2003

ponaparte2003

    biết vẽ rectang

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

Đã gửi 22 June 2011 - 02:10 PM

trong lúc thiết kế em gặp phải vấn đề như sau :
2 ) khi thiết kế xong mặt cắt ngang có những điểm mình cần tính cao độ nhưng phải làm bằng thủ công nên em muốn nhờ các bác viết hộ cái lip tính cao độ với ý tưởng như sau :
+ chọn điển gốc và nhập cao độ điểm đó
+ kick vào điểm cần tính cao độ
+ kick vào teext cần thay
+ nếu không có text thì kích vào điểm bất kỳ để tạo têxt
+ kick điểm tiếp theo
+ kick hết diểm ấn enter đẻ kết thúc lệnh
thank các bác !

http://www.cadviet.com/upfiles/3/tra_do_doc_.lsp
Đây là yêu cầu thứ nhất của bạn về độ dốc.
http://www.cadviet.c...pick_cao_do.lsp
Đây là yêu cầu thứ 2 của bạn về cao độ điểm bất kỳ trên trắc ngang mà bạn muốn Pick
  • 1
Y=acosh(x/a)

#3677 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 22 June 2011 - 02:30 PM

http://www.cadviet.com/upfiles/3/bosungdieukien.dwg
anh có thể giúp em về phần độ dốc cái cống đã vì hiện tại em cần cái đó lắm. còn cái cao độ thì em đã nhờ bạn em viết 1 cái lip cũng đúng như mong muốn vì bạn em cũng đã từng gặp trường hợp như vậy nhưng cũng chỉ mò mẫm hay mót gì đó nên nó ko hoàn chỉnh . em đua code nó lên đây anh xem và rút gon cho em cái .
hoặc lược bỏ phần không cần thiết vì khi chạy nó thì nó chống với tất cả các lip khác mới đau em

Hề hề hề,
Dây là cái lisp ghi độ dốc:

(defun c:gdd (/ en p1 p2 doc dd goc p txt et )
(command "undo" "be")
(setq en (car (entsel "\n Chon LINE can xac dinh do doc"))
p1 (cdr (assoc 10 (entget en)))
p2 (cdr (assoc 11 (entget en)))
doc (abs (* (/ (sin (angle p1 p2)) (cos (angle p1 p2))) 100))
dd (strcat (rtos doc 2 2) "%%%")
)
(if (and (> (angle p1 p2) (/ pi 2)) (< (angle p1 p2) (* pi 1.5)))
(setq goc (+ (angle p1 p2) pi))
(setq goc (angle p1 p2))
)
(setq txt (car (entsel "\n Chon text can ghi do doc")))
(if (= txt nil)
(progn
(setq p (getpoint "\n Pick diem can ghi do doc"))
(setq txt (car (entsel "\n Chon text mau")))
(if (/= txt nil)
(entmake (list (cons 0 "text") (assoc 40 (entget txt)) (cons 10 p) (assoc 8 (entget txt)) (assoc 7 (entget txt)) (cons 1 dd) (cons 50 goc)))
)
)
(progn
(setq et (entget txt)
et (subst (cons 1 dd) (assoc 1 et) et)
)
(entmod et)
)
)
(command "undo" "e")
(princ)
)


Hy vọng trúng ý bạn.
Lưu ý khi lisp yêu cầu Chon text can ghi do doc , nếu bạn khong muốn chọn text để thay thế mà muốn chọn điểm để ghi text mới thì cú việc nhấn Enter. Khi đó lisp sẽ yêu cầu bạn chọn điểm đặt text mới.
Còn nến bạn muốn thay thế text cũ thì phải chọn đúng vào text cần thay.
Khi lisp yêu cầu bạn Chon text mau thì bạn phải chọn đúng cái text mẫu có style, layer, chiều cao mà bạn muốn.
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.

#3678 minhhieuthanh

minhhieuthanh

    biết zoom

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

Đã gửi 22 June 2011 - 03:09 PM

Lisp dài quá, đọc để hiểu hết e hơi mệt, lại không có file CAD để test, dân ngoại đạo thật vất vả để hiểu. CHi bằng bạn tự sửa nhé.
Thêm dòng :

vào sau dòng (Defun c:DMTN()
sau đó tìm tất cả số 0.02 (2%) trong lisp thay bằng im, tất cả số 0.01 (1%) thay bằng il
Như vậy có khả năng là ok, cũng dễ hiểu nữa ^^

CÁM ƠN ANH.
em đã sửa như anh nói, khi chạy thì cũng cho nhập nhưng mà cuối cùng thì bị lỗi là : "Select objects: ; error: bad function: 1.66".
em cũng không rành về lisp mong các anh giúp đỡ
lisp sau khi em sửa :http://www.mediafire.com/?srw4h79mae4pssc
  • 0

#3679 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 22 June 2011 - 03:23 PM

http://www.cadviet.com/upfiles/3/tra_do_doc_.lsp
Đây là yêu cầu thứ nhất của bạn về độ dốc.
http://www.cadviet.c...pick_cao_do.lsp
Đây là yêu cầu thứ 2 của bạn về cao độ điểm bất kỳ trên trắc ngang mà bạn muốn Pick

thank bac đã quan tâm tới em nhưng 2 cái lip đó đều ko dùng dc bác à .
cai tra độ đốc nó ko ra %
cái pick cao độ thì em ko hiểu nó chạy như thế nào
  • 0

#3680 hakhoailang

hakhoailang

    biết lệnh rotate

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

Đã gửi 22 June 2011 - 03:26 PM

Hề hề hề,
Dây là cái lisp ghi độ dốc:


(defun c:gdd (/ en p1 p2 doc dd goc p txt et )
(command "undo" "be")
(setq en (car (entsel "\n Chon LINE can xac dinh do doc"))
p1 (cdr (assoc 10 (entget en)))
p2 (cdr (assoc 11 (entget en)))
doc (abs (* (/ (sin (angle p1 p2)) (cos (angle p1 p2))) 100))
dd (strcat (rtos doc 2 2) "%%%")
)
(if (and (> (angle p1 p2) (/ pi 2)) (< (angle p1 p2) (* pi 1.5)))
(setq goc (+ (angle p1 p2) pi))
(setq goc (angle p1 p2))
)
(setq txt (car (entsel "\n Chon text can ghi do doc")))
(if (= txt nil)
(progn
(setq p (getpoint "\n Pick diem can ghi do doc"))
(setq txt (car (entsel "\n Chon text mau")))
(if (/= txt nil)
(entmake (list (cons 0 "text") (assoc 40 (entget txt)) (cons 10 p) (assoc 8 (entget txt)) (assoc 7 (entget txt)) (cons 1 dd) (cons 50 goc)))
)
)
(progn
(setq et (entget txt)
et (subst (cons 1 dd) (assoc 1 et) et)
)
(entmod et)
)
)
(command "undo" "e")
(princ)
)


Hy vọng trúng ý bạn.
Lưu ý khi lisp yêu cầu Chon text can ghi do doc , nếu bạn khong muốn chọn text để thay thế mà muốn chọn điểm để ghi text mới thì cú việc nhấn Enter. Khi đó lisp sẽ yêu cầu bạn chọn điểm đặt text mới.
Còn nến bạn muốn thay thế text cũ thì phải chọn đúng vào text cần thay.
Khi lisp yêu cầu bạn Chon text mau thì bạn phải chọn đúng cái text mẫu có style, layer, chiều cao mà bạn muốn.
Chúc bạn vui.

cái lip này bác tặng em thì quá ok luôn nhưng khổ nỗi nó cứ có 2 số 0 ở sau đuôi cái số mà mình vừa ghi độ dốc ấy em tìm cách sửa mà bó tay bác à.bác giúp nốt em nhé
thank bác
  • 0