Chuyển đến nội dung
Diễn đàn CADViet
tuoiti

Xin lisp điền cao độ cống!

Các bài được khuyến nghị

Ai có lisp điền cao độ các điểm trên cống tại các vị trí: vai đường,gia cố,đáy móng V.V.....cống khi biết cao độ tim đường tại vị trí cống.Thanhks!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

 

Bạn có thể dùng cái này mình viết và đang dùng, do mã Lsp lộn xộn nên để trong file *.fas để các bác nhìn thấy lại ..........khì.

http://maxup.vn/tai-ve/fqdg8mb6opi6p1o/xaa...ncaodo.fas.html

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bạn có thể dùng cái này mình viết và đang dùng, do mã Lsp lộn xộn nên để trong file *.fas để các bác nhìn thấy lại ..........khì.

http://maxup.vn/tai-ve/fqdg8mb6opi6p1o/xaa...ncaodo.fas.html

của bạn đây :

Cái lisp này bị vấn đề là dùng xong nó mất chế độ bắt điểm, Mình loay hoay nhưng chưa sửa được, Bác pro nào thêm dòng lệnh bật lại chế độ bắt điểm júp em luôn với !

CODE

 

;VE CAO TRINH

 

(DEFUN C:CT (/ CMD PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 NPI TX DX DY TL OSM OLL

CRST RSIZE TSIZE STR PRMT FCH NBC OLDERR)

;(SETQ OLDERR *error*

; *error* loisb)

(command "layer" "m" "ghichu" "c" "150" """")

(setq oldos (getvar "osmode"))

;(setvar "osmode" 0)

(SETQ CMD (GETVAR "CMDECHO"))

(SETQ NBC (GETVAR "CLAYER"))

(SETVAR "CMDECHO" 0)

(SETQ PT1 (GETPOINT "\nDiem cao trinh:"))

(SETQ TX (GETSTRING "\nCao trinh:"))

(SETQ FCH (SUBSTR TX 1 1))

(IF (= FCH "@") (SETQ TX (STRCAT "%%P" (SUBSTR TX 2 (- (STRLEN TX) 1)))))

(SETQ CRST (GETVAR "TEXTSTYLE"))

(SETQ RSIZE (CDR (ASSOC 40 (TBLSEARCH "STYLE" CRST))))

(SETQ TSIZE (GETVAR "TEXTSIZE"))

(SETQ STR (RTOS TSIZE 2))

(SETQ PRMT (STRCAT "\nText height <" STR ">:"))

(IF (= RSIZE 0)

(PROGN

(INITGET 4)

(SETQ TSIZE (GETREAL PRMT))

(IF (= TSIZE NIL) (SETQ TSIZE (GETVAR "TEXTSIZE"))

(SETVAR "TEXTSIZE" TSIZE))

)

)

(PRINC)

(SETQ TL (/ (GETVAR "TEXTSIZE") 2))

(SETVAR "OSMODE" 0)

(SETQ DX (CAAR (CDR (TEXTBOX (LIST (CONS 1 TX))))))

(SETQ NPI (/ PI 2))

(SETQ PT4 (POLAR PT1 NPI (* 1 TL)))

(SETQ PT2 (POLAR PT4 PI (* 2 TL)))

(SETQ PT3 (POLAR PT4 0 (* 2 TL)))

(SETQ PT5 (POLAR PT4 NPI (* 5 TL)))

(SETQ PT6 (POLAR PT2 NPI TL))

(SETQ PT7 (POLAR PT6 0 (+ (* 3.7 TL) DX)))

(SETQ PT8 (POLAR PT6 NPI (* 1 TL)))

(SETQ PT8 (POLAR PT8 0 (* 2.5 TL)))

(SETQ PT9 (POLAR PT1 pi (* 2 TL)))

(SETQ PT10 (POLAR PT1 0 (* 2 TL)))

(COMMAND "COLOR" "84" "")

(command "-style" "cao trinh" "jang.shx" "0" "1" "0" "n" "n" "n")

(IF (= RSIZE 0)(COMMAND "TEXT" PT8 TSIZE 0 tX) (COMMAND "TEXT" PT8 0 TX))

(COMMAND "COLOR" "7" "")

(COMMAND "SOLID" PT1 PT2 PT4 "" "" "pLINE" PT1 pt3 pt2 "")

(COMMAND "COLOR" "150" "")

(COMMAND "pLINE" PT1 PT5 "" "pLINE" PT6 PT7 "" "pLINE" pt9 pt10"")

(SETVAR "CLAYER" "0")

(command "ddedit" pause)

(COMMAND "COLOR" "BYLAYER" "")

(SETVAR "CMDECHO" CMD)

(SETVAR "CLAYER" NBC)

(setvar "osmode" 687)

(PRINC)

)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
của bạn đây :

Cái lisp này bị vấn đề là dùng xong nó mất chế độ bắt điểm, Mình loay hoay nhưng chưa sửa được, Bác pro nào thêm dòng lệnh bật lại chế độ bắt điểm júp em luôn với !

Bạn ghi dòng lệnh này vào cuối chương trình trước dòng (princ)

trong đó có nhiều chế độ truy bắt . Không dùng cái nào thì bỏ bớt đi "in, end...."

(command "osnap" "INT,end,mid,cen,nod,qua,ins,per,tan,nea,quick,app" "")

Chúc vui !

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
của bạn đây :

Cái lisp này bị vấn đề là dùng xong nó mất chế độ bắt điểm, Mình loay hoay nhưng chưa sửa được, Bác pro nào thêm dòng lệnh bật lại chế độ bắt điểm júp em luôn với !

Chào bạn hhhhgggg,

Bạn thử thay dòng code này: (setvar "osmode" 687) bằng đoạn code sau :(setvar "osmode" oldos) xem nhé.

Chúc bạn vui.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Chào hhhhggg,

Mình có lisp này nó chạy ra khoảng cách so với điểm gốc và cao độ tuyệt đối (dựa vào điểm gốc). Tuy nhiên text xuất ra không được đẹp lắm. Lisp này thích hợp cho cả tính cao độ cống, cao độ đào đắp đất không thích hợp. Bạn nào giỏi về lisp kết hợp 2 lisp này ra kết quả là một leader hoặc một block giống của hhhhggg với Mtext có 2 dòng : 1 dòng là cao độ tuyệt đối, một dòng là khoảng cách tương đối so với điểm gốc thì tốt.

 

Lisp mình như sau:

;*******************************************************************************

 

***************;

;Ghi cao do, offset cua diem can cu vao diem goc

(defun c:eff ( / pt p1 p01 p02 ent ecopy elev elev1 offset etype txth)

(setvar "osmode" 1)

(command "ucs" "w")

(setq pt (getpoint "\nPick reference point: ")

ent (entget(car(entsel "\nSelect elevation text: ")))

etype (cdr(assoc 0 ent))

txth (cdr(assoc 40 ent))

)

(if (/= etype "TEXT") (progn

(princ "\nThe elevation selection must be a TEXT entity")

(exit))

(setq elev (atof(cdr(assoc 1 ent))))

)

 

(command "layer" "m" "UNSUITABLE" "")

 

(while (setq p1(getpoint "\nPick offset point"))

(setq elev1 (+ elev (- (cadr p1) (cadr pt)))

offset (abs(- (car p1) (car pt)))

p01 (polar p1 (* 3.0 (/ pi 2)) txth)

p01 (polar p01 pi (* 0.9 txth))

p02 (polar p01 0 (* 1.6 txth))

ecopy (list (assoc 0 ent)

(cons 100 "AcDbEntity")

(cons 8 "UNSUITABLE")

(cons 100 "AcDbText")

(assoc 10 ent)

(assoc 40 ent)

(cons 1 (strcat "Cao ®é: " (rtos elev1 2 2)))

(assoc 50 ent)

(assoc 41 ent)

(assoc 51 ent)

(assoc 7 ent)

(cons 71 0)

(cons 72 2)

(list 11 (car p01) (cadr p01) 0.0)

(list 210 0.0 0.0 1.0)

(cons 100 "AcDbText")

(cons 73 2)

)

)

(entmake ecopy)

(setq ecopy (list (assoc 0 ent)

(cons 100 "AcDbEntity")

(cons 8 "UNSUITABLE")

(cons 100 "AcDbText")

(assoc 10 ent)

(assoc 40 ent)

(cons 1 (strcat "K.c¸ch: " (rtos offset 2 2)))

(assoc 50 ent)

(assoc 41 ent)

(assoc 51 ent)

(assoc 7 ent)

(cons 71 0)

(cons 72 2)

(list 11 (car p02) (cadr p02) 0.0)

(list 210 0.0 0.0 1.0)

(cons 100 "AcDbText")

(cons 73 2)

)

)

(entmake ecopy)

(princ "\nPress ESC or SPACE bar to cancel")

)

(end_task)

)

 

 

 

Chúc các bạn vui vẻ!

 

của bạn đây :

Cái lisp này bị vấn đề là dùng xong nó mất chế độ bắt điểm, Mình loay hoay nhưng chưa sửa được, Bác pro nào thêm dòng lệnh bật lại chế độ bắt điểm júp em luôn với !

CODE

 

;VE CAO TRINH

 

(DEFUN C:CT (/ CMD PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 NPI TX DX DY TL OSM OLL

CRST RSIZE TSIZE STR PRMT FCH NBC OLDERR)

;(SETQ OLDERR *error*

; *error* loisb)

(command "layer" "m" "ghichu" "c" "150" """")

(setq oldos (getvar "osmode"))

;(setvar "osmode" 0)

(SETQ CMD (GETVAR "CMDECHO"))

(SETQ NBC (GETVAR "CLAYER"))

(SETVAR "CMDECHO" 0)

(SETQ PT1 (GETPOINT "\nDiem cao trinh:"))

(SETQ TX (GETSTRING "\nCao trinh:"))

(SETQ FCH (SUBSTR TX 1 1))

(IF (= FCH "@") (SETQ TX (STRCAT "%%P" (SUBSTR TX 2 (- (STRLEN TX) 1)))))

(SETQ CRST (GETVAR "TEXTSTYLE"))

(SETQ RSIZE (CDR (ASSOC 40 (TBLSEARCH "STYLE" CRST))))

(SETQ TSIZE (GETVAR "TEXTSIZE"))

(SETQ STR (RTOS TSIZE 2))

(SETQ PRMT (STRCAT "\nText height <" STR ">:"))

(IF (= RSIZE 0)

(PROGN

(INITGET 4)

(SETQ TSIZE (GETREAL PRMT))

(IF (= TSIZE NIL) (SETQ TSIZE (GETVAR "TEXTSIZE"))

(SETVAR "TEXTSIZE" TSIZE))

)

)

(PRINC)

(SETQ TL (/ (GETVAR "TEXTSIZE") 2))

(SETVAR "OSMODE" 0)

(SETQ DX (CAAR (CDR (TEXTBOX (LIST (CONS 1 TX))))))

(SETQ NPI (/ PI 2))

(SETQ PT4 (POLAR PT1 NPI (* 1 TL)))

(SETQ PT2 (POLAR PT4 PI (* 2 TL)))

(SETQ PT3 (POLAR PT4 0 (* 2 TL)))

(SETQ PT5 (POLAR PT4 NPI (* 5 TL)))

(SETQ PT6 (POLAR PT2 NPI TL))

(SETQ PT7 (POLAR PT6 0 (+ (* 3.7 TL) DX)))

(SETQ PT8 (POLAR PT6 NPI (* 1 TL)))

(SETQ PT8 (POLAR PT8 0 (* 2.5 TL)))

(SETQ PT9 (POLAR PT1 pi (* 2 TL)))

(SETQ PT10 (POLAR PT1 0 (* 2 TL)))

(COMMAND "COLOR" "84" "")

(command "-style" "cao trinh" "jang.shx" "0" "1" "0" "n" "n" "n")

(IF (= RSIZE 0)(COMMAND "TEXT" PT8 TSIZE 0 tX) (COMMAND "TEXT" PT8 0 TX))

(COMMAND "COLOR" "7" "")

(COMMAND "SOLID" PT1 PT2 PT4 "" "" "pLINE" PT1 pt3 pt2 "")

(COMMAND "COLOR" "150" "")

(COMMAND "pLINE" PT1 PT5 "" "pLINE" PT6 PT7 "" "pLINE" pt9 pt10"")

(SETVAR "CLAYER" "0")

(command "ddedit" pause)

(COMMAND "COLOR" "BYLAYER" "")

(SETVAR "CMDECHO" CMD)

(SETVAR "CLAYER" NBC)

(setvar "osmode" 687)

(PRINC)

)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×