Đến nội dung


Hình ảnh
- - - - -

Nhờ admin sửa gìum lisp chèn cao độ và khoảng cách


  • Please log in to reply
5 replies to this topic

#1 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 19 April 2010 - 11:53 AM

Em có một lisp dùng để tính cao độ và khoảng cách so với điểm gốc. Lisp này khi chạy thì ra text cao độ tuyệt đối và khoảng cách offset. Em muốn giữa 2 text này có thêm một đoạn thẳng ngăn cách giữa 2 text. Mong các bác sửa giùm em. Xin chân thành cảm ơn.
Mã của lisp 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 "" (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 "" (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)
)
  • 0

#2 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 21 April 2010 - 01:46 PM

Cảm ơn bạn rất nhiều. Đúng là cái mình muốn đó.
Chúc bạn luôn vui vẻ và gặp nhiều may mắn!
  • 0

#3 thanhhuyen7789

thanhhuyen7789

    biết pan

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

Đã gửi 24 August 2011 - 06:42 AM

chào admin mình đang cân có cái lisp tinh cao do để làm hoàn công. Nội dung như sau: tính cao độ từ cao độ có sẵn va dịnh dạng được fonts theo tỷ lệ từng file bản vẽ khác nhau. Vi minh đang dung xidn thoại nên không thể up file cua mình len đươc mong admin lam giup minh. Kèm theo số ghi cao độ đó là blook thuộc tính của nó nữa admin ạ. Cam ơn ban nhiều nhé!
  • 0

#4 thanhhuyen7789

thanhhuyen7789

    biết pan

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

Đã gửi 25 August 2011 - 07:31 AM

D
------------------------------
chào admin mình đang cân có cái lisp tinh cao do để làm hoàn công. Nội dung như sau: tính cao độ từ cao độ có sẵn va dịnh dạng được fonts theo tỷ lệ từng file bản vẽ khác nhau. Vi minh đang dung xidn thoại nên không thể up file cua mình len đươc mong admin lam giup minh. Kèm theo số ghi cao độ đó là blook thuộc tính của nó nữa admin ạ. Cam ơn ban nhiều nhé!
Đầy là đoạn mã trong lisp minh có.
(DEFUN C:DTL() ;(Chuong trinh doi ty le ban ve);
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
------------------------------

(defun c:DT1()
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(if (= vol nil) (progn
(setq vol (getreal "\nAll Quanttities(1) or Half(2): "))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 3000 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ (/ dtl He_so2) vol))
; (setq pt2 (getpoint "\nChon diem ghi ra : "))
; (command "text" "J" "M" pt2 2 0 (rtos dtl 2 2))
; (setq pt3 (rtos dtl 2 2))
; (while (null (setq pt5 (entsel "\nChon so ghi can sua:"))))
; (setq dt (entget (car pt5)))
; (setq loai (cdr (assoc 0 dt)))
; (if (= dtl "TEXT")

(progn
(setq pt3 (rtos dtl 2 2))
(setq pt5 (entsel "\nChon so ghi can sua :"))
(initget 0)
(if (null pt5)

(progn
(setq pt6 (getpoint "\nChon diem de the ghi : " ))
(command "text" "J" "M" pt6 2 "0" pt3)
)
(progn
(setq dt (entget (car pt5)))
(setq loai (cdr (assoc 0 dt)))
(command ".change" pt5 "" "" "" "" (cdr (assoc 40 dt)) "" pt3)
(command ".change" pt5 "" "P" "C" "7" "")
)
)
)
; (print)
; (prompt (strcat "\nTotal area : " (rtos dTy_le 2 4)))
; (print)
; (setq pt2 (getpoint "\nPoint to write: "))
; (command "text" pt2 "" "0" (rtos dtl 2 2))
);defun
------------------------------
(DEFUN C:TCD() ;(Chuong trinh tim cao do);
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(command "_layer" "new" "Text" "color" "white" "Text" "")
(setvar "REGENMODE" 0)
(setvar "CMDECHO" 0)
(setq cu (getvar "OSMODE"))
(Command "-osnap" "INT")
(Command "UCS" "W")
; (initget 129 "Y N")
; (setq dk (getkword "\nCo lay cao do o vi tri bat ky?<Y/N>:"))
; (if (= dk "Y")
(progn
(setq OO1 (getpoint "\nPick diem lay cao do: "))
(setq Xt (car OO1)
Yt (cadr OO1)
XOY (list Xt Yt)
))
; (progn
; (setq OO (getpoint "\nPick tim duong thiet ke : "))
; (setq
; XOY (List (car OO) (- (cadr OO) (* 0.25 He_so)))
; Xt (car XOY)
; Yt (cadr XOY)
; ))
; )
(setvar "OSMODE" 0)
(Command "UCS" "O" XOY)
(setq text (car (nentsel "\nChon cao do TKe :")))
(Command "-osnap" "INT,END")
(setq k (getpoint "\nChon diem tim cao do :"))
(while (/= text nil)
(progn
(setq st2 (entget text)) ;;hien thi record doi tuong
(setq st (cdr (assoc 1 st2))) ;;Lay noi dung text:ma DXF=1
(setq cdotim (atof st)
tim (getpoint "\ndiem dat :")
tim (list (car tim) (+ (cadr tim) 0.85))
Xt (/ (car k) he_so)
Yt (+ (/ (cadr k) he_so) cdotim)
gtr (rtos yt 2 2)
; h 8.0
h (* he_so 0.2)
)
(Command "_layer" "set" "text" "")
; (Command "text" tim h "0" gtr "")
; (command "_layer" "set" "0" "")
(Command "-osnap" "NONE")
(Command "text" "J" "ML" tim h "0" gtr "")
(princ "\n Khoang cach tu Tim: ")
(prin1 Xt)
(Command "-osnap" "INT,END")
(setq k (getpoint "\nChon diem tim cao do tiep theo :" ))
(princ)
))
(setvar "OSMODE" cu)
(princ)
)
------------------------************-------------------
(DEFUN C:KCa() ;(Chuong trinh viet K/C le);
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(setvar "REGENMODE" 0)
(setvar "CMDECHO" 0)
(setq cu (getvar "OSMODE"))
(Command "-osnap" "MID")
(setq Chan (getpoint "\nChon diem dat TEXT :"))
(setq Ych (- (cadr Chan) 0.5) )
(Command "-osnap" "END")
(setq A1 (getpoint "\nChon diem thu nhat :")
A2 (getpoint "\nChon diem thu 2 :")
ht 2.0
; ht (/ he_so 2.5)
)
(While (/= A2 nil)
(progn
(setq Xa1 (car A1)
Xa2 (car A2)
Tb (/ (+ Xa1 Xa2) 2)
Dat (list Tb Ych)
DISS (/ (abs (- Xa1 Xa2)) He_so)
DIS (rtos DISS 2 2)
)
----------
(if (< DISS 1)
(setq Ang 90)
(setq Ang 0)
)
-----------
(Command "-osnap" "")
(Command "text" "J" "M" Dat ht Ang DIS)
)
(Command "-osnap" "END")
(setq A1 (getpoint "\nChon diem thu nhat :")
A2 (getpoint "\nChon diem thu 2 :"))
)
(setvar "OSMODE" cu)
(princ)
)
---------------------********-----------------------
(defun C:SCC () ;Chuong trinh sua lai do doc mat duong
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(setq st1 (car (entsel "\nPick cao do thu nhat : "))) ;;Lay ma doi tuong
(setq st1 (entget st1)) ;;hien thi record doi tuong
(setq st (cdr (assoc 1 st1))) ;;Lay noi dung text:ma DXF=1
(setq a1 (atof st))
(prin1 a1)
(setq st2 (car (entsel "\nPick cao do thu hai: "))) ;;Lay ma doi tuong
(setq st2 (entget st2)) ;;hien thi record doi tuong
(setq st (cdr (assoc 1 st2))) ;;Lay noi dung text:ma DXF=1
(setq a2 (atof st))
(prin1 a2)
(setq kc (atof (cdr (assoc 1 (entget (car (entsel "\nPick K/C :")))))))
(print kc)
(setq sc (* 100 (/ (- a1 a2) kc))
sc (rtos sc 2 2)
sc (strcat sc "%")
)
(setq en (car (entsel "\nThay cho do doc ngang : ")))
(setq elst (entget en))
(setq elst (subst (cons 1 (strcat " " sc)) (assoc 1 elst) elst))
(setq elst (append elst '((62 . 3))));7 trang
(prin1 elst)
(entmod elst)
)
-----------------------***********----------------------
(Defun C:ddan() ;CT VIET DUONG DAN CUA BAN VE
(setvar "REGENMODE" 0)
(setvar "CMDECHO" 0)
(setq last (getvar "OSMODE"))
(Command "-osnap" "END")
(if (= TEN nil) (setq TEN (getstring "\nMay cua ai: ")))
(setq NAME (getvar "dwgname")
PATH (getvar "dwgprefix")
POINT (getpoint "\nPick Bottum_Letf :")
POINT (list (- (car POINT) 3) (cadr POINT))
ND (strcat "TV8-TK2-" TEN " FILE: " PATH NAME)
)
(Command "_layer" "set" "0" "")
(Command "-osnap" "NONE")
(Command "Text" POINT "2.0" "90" ND)
(setvar "OSMODE" last)
(princ)
)
------------------------------------------------

(DEFUN XD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nSelect vertical dimension(s) extensions to be aligned")
(SETQ SET (SSGET))
(PROMPT"\nSelect new extension position")
(SETQ P1 (GETPOINT))
(SETQ X3 (CAR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
(WHILE (< INDEX QUANT)
(IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
)
(PROGN
(SETQ L13 (ASSOC 13 A))
(SETQ M13 (CDR L13))
(SETQ L14 (ASSOC 14 A))
(SETQ M14 (CDR L14))
(SETQ P13 (LIST 13 X3 (CADR M13) (CADDR M13)))
(SETQ P14 (LIST 14 X3 (CADR M14) (CADDR M14)))
(SETQ A (SUBST P13 L13 A))
(SETQ A (SUBST P14 L14 A))
(ENTMOD A)
)
)
(SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(PRINC)
)
(DEFUN C:XD () (XD) )
(DEFUN C:XX () (XD) )
(DEFUN C:SDD () (XD) )
--------------------------------------
(DEFUN YD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nSelect dimension(s) to be aligned")
(SETQ SET (SSGET))
(PROMPT"\nSelect new dimension position")
(SETQ P1 (GETPOINT))
(SETQ Y3 (CADR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
(WHILE (< INDEX QUANT)
(IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
)
(PROGN
(SETQ L13 (ASSOC 13 A))
(SETQ M13 (CDR L13))
(SETQ L14 (ASSOC 14 A))
(SETQ M14 (CDR L14))
(SETQ P13 (LIST 13 (CAR M13) Y3 (CADDR M13)))
(SETQ T13 (CDR P13))
(SETQ P14 (LIST 14 (CAR M14) Y3 (CADDR M14)))
(SETQ A (SUBST P13 L13 A))
(SETQ A (SUBST P14 L14 A))
(ENTMOD A)
)
)
(SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
(DEFUN C:YD () (YD) )
(DEFUN C:YY () (YD) )
(DEFUN C:SDN () (YD) )
-------------------------------------
(DEFUN YD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nChon dim can cat")
(SETQ SET (SSGET))
(PROMPT"\nChon vi tri cat")
(SETQ P1 (GETPOINT))
(SETQ Y3 (CADR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
(WHILE (< INDEX QUANT)
(IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
)
(PROGN
(SETQ L13 (ASSOC 13 A))
(SETQ M13 (CDR L13))
(SETQ L14 (ASSOC 14 A))
(SETQ M14 (CDR L14))
(SETQ P13 (LIST 13 (CAR M13) Y3 (CADDR M13)))
(SETQ T13 (CDR P13))
(SETQ P14 (LIST 14 (CAR M14) Y3 (CADDR M14)))
(SETQ A (SUBST P13 L13 A))
(SETQ A (SUBST P14 L14 A))
(ENTMOD A)
)
)
(SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
(DEFUN C:YD () (YD) )
(DEFUN C:ww () (YD) )
(DEFUN C:SDN () (YD) )
------------------------
(load "C:/acad.lsp")
(load "C:/catdoc.lsp")
(load "C:/loadhet.lsp")
  • 0

#5 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 25 August 2011 - 10:09 AM

D
------------------------------
chào admin mình đang cân có cái lisp tinh cao do để làm hoàn công. Nội dung như sau: tính cao độ từ cao độ có sẵn va dịnh dạng được fonts theo tỷ lệ từng file bản vẽ khác nhau. Vi minh đang dung xidn thoại nên không thể up file cua mình len đươc mong admin lam giup minh. Kèm theo số ghi cao độ đó là blook thuộc tính của nó nữa admin ạ. Cam ơn ban nhiều nhé!
Đầy là đoạn mã trong lisp minh có.
(DEFUN C:DTL() ;(Chuong trinh doi ty le ban ve);
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
------------------------------

(defun c:DT1()
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(if (= vol nil) (progn
(setq vol (getreal "\nAll Quanttities(1) or Half(2): "))
)
)
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "osnap" "")
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
(while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 3000 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(command "setvar" "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ (/ dtl He_so2) vol))
; (setq pt2 (getpoint "\nChon diem ghi ra : "))
; (command "text" "J" "M" pt2 2 0 (rtos dtl 2 2))
; (setq pt3 (rtos dtl 2 2))
; (while (null (setq pt5 (entsel "\nChon so ghi can sua:"))))
; (setq dt (entget (car pt5)))
; (setq loai (cdr (assoc 0 dt)))
; (if (= dtl "TEXT")

(progn
(setq pt3 (rtos dtl 2 2))
(setq pt5 (entsel "\nChon so ghi can sua :"))
(initget 0)
(if (null pt5)

(progn
(setq pt6 (getpoint "\nChon diem de the ghi : " ))
(command "text" "J" "M" pt6 2 "0" pt3)
)
(progn
(setq dt (entget (car pt5)))
(setq loai (cdr (assoc 0 dt)))
(command ".change" pt5 "" "" "" "" (cdr (assoc 40 dt)) "" pt3)
(command ".change" pt5 "" "P" "C" "7" "")
)
)
)
; (print)
; (prompt (strcat "\nTotal area : " (rtos dTy_le 2 4)))
; (print)
; (setq pt2 (getpoint "\nPoint to write: "))
; (command "text" pt2 "" "0" (rtos dtl 2 2))
);defun
------------------------------
(DEFUN C:TCD() ;(Chuong trinh tim cao do);
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(command "_layer" "new" "Text" "color" "white" "Text" "")
(setvar "REGENMODE" 0)
(setvar "CMDECHO" 0)
(setq cu (getvar "OSMODE"))
(Command "-osnap" "INT")
(Command "UCS" "W")
; (initget 129 "Y N")
; (setq dk (getkword "\nCo lay cao do o vi tri bat ky?<Y/N>:"))
; (if (= dk "Y")
(progn
(setq OO1 (getpoint "\nPick diem lay cao do: "))
(setq Xt (car OO1)
Yt (cadr OO1)
XOY (list Xt Yt)
))
; (progn
; (setq OO (getpoint "\nPick tim duong thiet ke : "))
; (setq
; XOY (List (car OO) (- (cadr OO) (* 0.25 He_so)))
; Xt (car XOY)
; Yt (cadr XOY)
; ))
; )
(setvar "OSMODE" 0)
(Command "UCS" "O" XOY)
(setq text (car (nentsel "\nChon cao do TKe :")))
(Command "-osnap" "INT,END")
(setq k (getpoint "\nChon diem tim cao do :"))
(while (/= text nil)
(progn
(setq st2 (entget text)) ;;hien thi record doi tuong
(setq st (cdr (assoc 1 st2))) ;;Lay noi dung text:ma DXF=1
(setq cdotim (atof st)
tim (getpoint "\ndiem dat :")
tim (list (car tim) (+ (cadr tim) 0.85))
Xt (/ (car k) he_so)
Yt (+ (/ (cadr k) he_so) cdotim)
gtr (rtos yt 2 2)
; h 8.0
h (* he_so 0.2)
)
(Command "_layer" "set" "text" "")
; (Command "text" tim h "0" gtr "")
; (command "_layer" "set" "0" "")
(Command "-osnap" "NONE")
(Command "text" "J" "ML" tim h "0" gtr "")
(princ "\n Khoang cach tu Tim: ")
(prin1 Xt)
(Command "-osnap" "INT,END")
(setq k (getpoint "\nChon diem tim cao do tiep theo :" ))
(princ)
))
(setvar "OSMODE" cu)
(princ)
)
------------------------************-------------------
(DEFUN C:KCa() ;(Chuong trinh viet K/C le);
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(setvar "REGENMODE" 0)
(setvar "CMDECHO" 0)
(setq cu (getvar "OSMODE"))
(Command "-osnap" "MID")
(setq Chan (getpoint "\nChon diem dat TEXT :"))
(setq Ych (- (cadr Chan) 0.5) )
(Command "-osnap" "END")
(setq A1 (getpoint "\nChon diem thu nhat :")
A2 (getpoint "\nChon diem thu 2 :")
ht 2.0
; ht (/ he_so 2.5)
)
(While (/= A2 nil)
(progn
(setq Xa1 (car A1)
Xa2 (car A2)
Tb (/ (+ Xa1 Xa2) 2)
Dat (list Tb Ych)
DISS (/ (abs (- Xa1 Xa2)) He_so)
DIS (rtos DISS 2 2)
)
----------
(if (< DISS 1)
(setq Ang 90)
(setq Ang 0)
)
-----------
(Command "-osnap" "")
(Command "text" "J" "M" Dat ht Ang DIS)
)
(Command "-osnap" "END")
(setq A1 (getpoint "\nChon diem thu nhat :")
A2 (getpoint "\nChon diem thu 2 :"))
)
(setvar "OSMODE" cu)
(princ)
)
---------------------********-----------------------
(defun C:SCC () ;Chuong trinh sua lai do doc mat duong
(if (= Ty_le_N nil) (progn
(setq Ty_le_N (getreal "\nHorizontal Drawing scale : "))
(setq He_so (/ 1000 Ty_le_N))
(setq Ty_le_D (getreal "\nVertical Drawing scale : "))
(setq He_so1 (/ 1000 Ty_le_D))
(setq He_so2 (* He_so He_so1))
)
)
(setq st1 (car (entsel "\nPick cao do thu nhat : "))) ;;Lay ma doi tuong
(setq st1 (entget st1)) ;;hien thi record doi tuong
(setq st (cdr (assoc 1 st1))) ;;Lay noi dung text:ma DXF=1
(setq a1 (atof st))
(prin1 a1)
(setq st2 (car (entsel "\nPick cao do thu hai: "))) ;;Lay ma doi tuong
(setq st2 (entget st2)) ;;hien thi record doi tuong
(setq st (cdr (assoc 1 st2))) ;;Lay noi dung text:ma DXF=1
(setq a2 (atof st))
(prin1 a2)
(setq kc (atof (cdr (assoc 1 (entget (car (entsel "\nPick K/C :")))))))
(print kc)
(setq sc (* 100 (/ (- a1 a2) kc))
sc (rtos sc 2 2)
sc (strcat sc "%")
)
(setq en (car (entsel "\nThay cho do doc ngang : ")))
(setq elst (entget en))
(setq elst (subst (cons 1 (strcat " " sc)) (assoc 1 elst) elst))
(setq elst (append elst '((62 . 3))));7 trang
(prin1 elst)
(entmod elst)
)
-----------------------***********----------------------
(Defun C:ddan() ;CT VIET DUONG DAN CUA BAN VE
(setvar "REGENMODE" 0)
(setvar "CMDECHO" 0)
(setq last (getvar "OSMODE"))
(Command "-osnap" "END")
(if (= TEN nil) (setq TEN (getstring "\nMay cua ai: ")))
(setq NAME (getvar "dwgname")
PATH (getvar "dwgprefix")
POINT (getpoint "\nPick Bottum_Letf :")
POINT (list (- (car POINT) 3) (cadr POINT))
ND (strcat "TV8-TK2-" TEN " FILE: " PATH NAME)
)
(Command "_layer" "set" "0" "")
(Command "-osnap" "NONE")
(Command "Text" POINT "2.0" "90" ND)
(setvar "OSMODE" last)
(princ)
)
------------------------------------------------

(DEFUN XD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nSelect vertical dimension(s) extensions to be aligned")
(SETQ SET (SSGET))
(PROMPT"\nSelect new extension position")
(SETQ P1 (GETPOINT))
(SETQ X3 (CAR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
(WHILE (< INDEX QUANT)
(IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
)
(PROGN
(SETQ L13 (ASSOC 13 A))
(SETQ M13 (CDR L13))
(SETQ L14 (ASSOC 14 A))
(SETQ M14 (CDR L14))
(SETQ P13 (LIST 13 X3 (CADR M13) (CADDR M13)))
(SETQ P14 (LIST 14 X3 (CADR M14) (CADDR M14)))
(SETQ A (SUBST P13 L13 A))
(SETQ A (SUBST P14 L14 A))
(ENTMOD A)
)
)
(SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(PRINC)
)
(DEFUN C:XD () (XD) )
(DEFUN C:XX () (XD) )
(DEFUN C:SDD () (XD) )
--------------------------------------
(DEFUN YD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nSelect dimension(s) to be aligned")
(SETQ SET (SSGET))
(PROMPT"\nSelect new dimension position")
(SETQ P1 (GETPOINT))
(SETQ Y3 (CADR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
(WHILE (< INDEX QUANT)
(IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
)
(PROGN
(SETQ L13 (ASSOC 13 A))
(SETQ M13 (CDR L13))
(SETQ L14 (ASSOC 14 A))
(SETQ M14 (CDR L14))
(SETQ P13 (LIST 13 (CAR M13) Y3 (CADDR M13)))
(SETQ T13 (CDR P13))
(SETQ P14 (LIST 14 (CAR M14) Y3 (CADDR M14)))
(SETQ A (SUBST P13 L13 A))
(SETQ A (SUBST P14 L14 A))
(ENTMOD A)
)
)
(SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
(DEFUN C:YD () (YD) )
(DEFUN C:YY () (YD) )
(DEFUN C:SDN () (YD) )
-------------------------------------
(DEFUN YD ()
(SETQ CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "W")
(SETVAR "CMDECHO" 1)
(PROMPT"\nChon dim can cat")
(SETQ SET (SSGET))
(PROMPT"\nChon vi tri cat")
(SETQ P1 (GETPOINT))
(SETQ Y3 (CADR P1))
(SETQ QUANT (SSLENGTH SET))
(SETQ INDEX 0)
(WHILE (< INDEX QUANT)
(IF (AND(= "DIMENSION" (CDR (ASSOC 0 (SETQ A (ENTGET (SSNAME SET INDEX))))))
)
(PROGN
(SETQ L13 (ASSOC 13 A))
(SETQ M13 (CDR L13))
(SETQ L14 (ASSOC 14 A))
(SETQ M14 (CDR L14))
(SETQ P13 (LIST 13 (CAR M13) Y3 (CADDR M13)))
(SETQ T13 (CDR P13))
(SETQ P14 (LIST 14 (CAR M14) Y3 (CADDR M14)))
(SETQ A (SUBST P13 L13 A))
(SETQ A (SUBST P14 L14 A))
(ENTMOD A)
)
)
(SETQ INDEX (+ INDEX 1))
)
(SETVAR "CMDECHO" 0)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
)
(DEFUN C:YD () (YD) )
(DEFUN C:ww () (YD) )
(DEFUN C:SDN () (YD) )
------------------------
(load "C:/acad.lsp")
(load "C:/catdoc.lsp")
(load "C:/loadhet.lsp")

Chào thanhhuyen7789, nick của bạn nghe có vẻ là con gái (hoặc không ^^), hoặc là người đã đi làm.. Vậy mà, tuần nay rồi, mỗi lần lên CV là mình lại phải gửi tin mật cho bạn, xóa bài của bạn, tăng mức độ cảnh cáo, thậm chí nói thẳng trên diễn đàn về việc bạn vi phạm nội quy. Tuy nhiên bạn vẫn coi như không, cặm cụi post bài hết ngày này qua tháng khác cùng 1 chủ đề, cùng 1 lỗi sai, mà cũng không suy nghĩ 1 giây xem tại sao bài mình bị xóa..
Nếu bạn đang dùng điện thoại, chắc cũng phải cảm thông khi bạn post được 1 code dài như thế nhỉ, lỗi sai chính tả lần nào cũng y xì đúc hén :blush: Mà tại sao không bỏ 5 phút ra đọc nội quy ta :)
Nếu không có máy tính, dù mọi người có trâu đầu vào giúp thì bạn định appload lisp trên iphone chăng ?
Mình đành flag spam bạn thôi, có gì thì bạn đừng giận nha -_-
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#6 winter712

winter712

    biết vẽ polygon

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

Đã gửi 11 December 2013 - 08:53 AM

Mình cũng đang tìm một lips giống như của bạn thao_tedi, nhưng sao ko thấy câu trả lời mà đã thấy bạn thao cảm ơn rồi nhỉ, hay nó bị xóa rồi nhỉ


  • 0
[size=3][/size]Có ai đó nói rằng tôi đang lạc bước. Nhưng họ ko biết rằng tôi đã có 1 ước mơ…!
VIT NGOC