Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
10 replies to this topic

#1 tuoiti

tuoiti

    biết pan

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

Đã gửi 20 October 2009 - 11:12 AM

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!
  • 0

#2 tuoiti

tuoiti

    biết pan

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

Đã gửi 23 October 2009 - 04:56 PM

khó nhỉ
  • 0

#3 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 24 October 2009 - 08:21 AM

khó nhỉ

Mời bạn vào đây:
http://www.cadviet.c...?showtopic=5888
  • 0

#4 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 27 October 2009 - 10:29 PM

Mời bạn vào đây:
http://www.cadviet.c...?showtopic=5888



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-...ncaodo.fas.html
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#5 hhhhgggg

hhhhgggg

    biết dimedit

  • Members
  • PipPipPipPipPip
  • 393 Bài viết
Điểm đánh giá: 30 (tàm tạm)

Đã gửi 30 October 2009 - 05:22 AM

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-...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)
)
  • 0
Hoàng Giang

#6 HIELA

HIELA

    biết zoom

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

Đã gửi 30 October 2009 - 08:19 AM

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 !
  • 0

#7 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 31 October 2009 - 10:19 AM

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

#8 tuoiti

tuoiti

    biết pan

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

Đã gửi 06 November 2009 - 10:47 PM

Rất cảm ơn các bác đã giúp đỡ!
  • 0

#9 thao_tedi

thao_tedi

    biết zoom

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

Đã gửi 06 December 2009 - 02:24 PM

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)
)


  • 0

#10 vuquanghopxd

vuquanghopxd

    Chưa sử dụng CAD

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

Đã gửi 12 June 2012 - 11:06 AM

anh hhhhgggg oi lam sao de chinh text do ve lai nam ngang the. no nam xien thi ki qua
  • 0

#11 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 12 June 2012 - 03:28 PM

anh hhhhgggg oi lam sao de chinh text do ve lai nam ngang the. no nam xien thi ki qua

Hề hề hề ,
Nó xiên thế nào bạn hè?????
Hãy gửi file lê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.