Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa] Lisp vẽ trắc dọc mới


  • Please log in to reply
2 replies to this topic

#1 tiendung89

tiendung89

    biết lệnh move

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

Đã gửi 07 November 2011 - 08:51 AM

em có lisp trắc dọc thế này nhưng chưa dùng đc. nhờ các anh em trên diễn đàn chỉnh sửa giúp

;***********DAT TY LE************
(defun C:tle ()
(initget (+ 1 2 4))
(setq tld (getreal "\nTy le dung : "))
(setq tln (getreal "\nTy le ngang : "))
(setq dd (/ 1000 tld))
(setq nn (/ 1000 tln))
(setq tldn (* dd nn))
(setq hsd (/ 200.0 tld))
(setq hsn (/ 200.0 tln))
)
(if (= tld nil) (c:tle))
;***********LAY TOA DO************
(defun C:goc ()
(setq pt (getpoint "\nGoc toa do: "))
(setq xxx (car pt) yyy (cadr pt))
(setq elst (entget (car (entsel "\nCao do moc: "))))
(if (= nil elst) (setq cdg 0) (setq cdg (atof (DXF 1 elst))))
(setq elst (entget (car (entsel "\nLy trinh moc: "))))
(if (= nil ltg) (setq ltg 0) (setq ltg (atof (DXF 1 elst))))
)
;***********GHI CAO DO************
(defun C:GH ()
(vmon)
(print)
(setq eclast (getvar "CMDECHO"))
(setq lalast (getvar "CLAYER"))
(setq oslast (getvar "OSMODE"))
(setvar "CMDECHO" 0)
(setq sy dd)
(command "layer" "s" 0 "")
(setvar "osmode" 512)
(print)
(print)
(setq pt (getpoint "\nDiem goc toa do <nearest to> : "))
(setq yo (cadr pt))
(setq pt (getpoint "\nNoi ghi cao do <nearest to> : "))
(setq y2 (cadr pt))
(setq y1 (- y2 (* 5 hso)))
(setq y3 (- yo hso))
(setvar "osmode" 1)
(setq pt (getpoint "\nDiem chuan <end of) : ") )
(setq yc (cadr pt))
(initget (+ 1 4))
(setq hc (getreal "\nGia tri cao do : "))
(setq dy (- (* sy hc) yc))
(setvar "osmode" 33)
(print)
(print)
(setq pt (getpoint "\nDiem : "))
(while (/= pt nil)
;;(setq pt (osnap pt "end"))
(setq x (car pt) y (cadr pt))
(setq h (/ (+ y dy) sy))
; (setq x1 (+ x 1))
(setvar "osmode" 0)
(command "layer" "s" "6" "")
(command "line" (list x yo) (list x y) "")
(command "layer" "s" "0" "")
(command "line" (list x y1) (list x y2) "")
(command "style" "2B" "" (* 1.8 hso) "" "" "" "" "" )
(setq x (+ x (* 2.3 hso)))
(command "text" "r" (list x y3) 90 (rtos h 2 2))
(setvar "osmode" 33)
(print)
(print)
(setq pt (getpoint "\nDiem : "))
)
(setvar "OSMODE" oslast)
(setvar "CLAYER" lalast)
(setvar "CMDECHO" eclast)
;;(setvar "OSMODE" 0)
)
;***********GHI CHIEU DAI************
(defun C:GD ()
(setq gdt 0.00)
(setq gdd 0.00)

(setq p1 (getpoint "\nPick first point_ "))
(setq p2 (getpoint p1 "\nPick second point_ "))

(setq x1 (car p1) y1 (cadr p1) x2 (car p2) y2 (cadr p2))

(setq dx (/ (abs (- y1 y2)) dd) dy (/ (abs (- x2 x1)) nn))

(setq gdd (sqrt (+ (* dx dx) (* dy dy))))
(print gdd)

(setq elst (entget (car (entsel "\nTEXT to replace: "))))
(setq elst (subst (cons 1 (rtos gdd 2 2)) (assoc 1 elst) elst))
(entmod elst)
(print)
)
;***
;(defun C:GN ()
; (setq gdt 0.00)
; (setq gdd 0.00)
; (setq gdt (getdist "\nEnter distance or pick first point: "))
; (while (/= gdt nil)
; (setq gdd (+ gdd gdt))
; (setq gdt (getdist "\nEnter distance or pick first point: "))
; )
; (setq gdd (* (/ tln 1000.00) gdd))
; (print gdd)
; (setq elst (entget (car (entsel "\nTEXT to replace: "))))
; (setq elst (subst (cons 1 (rtos gdd 2 2)) (assoc 1 elst) elst))
; (entmod elst)
; (print)
;)
;***********GHI CU LY************
(defun C:CL ()
(setq gpt (getpoint "\nDiem can do: "))
(setq xg (car gpt))
(setq ddx (- xg xxx)
ddx (+ (* (/ tln 1000.00) ddx) ltg)
)
(princ (strcat "\n Ly trinh: " (rtos ddx 2 2)))
(setq elst (entget (car (entsel "\nGhi vao_ "))))
(setq elst (subst (cons 1 (rtos ddx 2 2)) (assoc 1 elst) elst))
(entmod elst)
(print)
)
;***********GHI CAO DO************
(defun C:CD ()
(setq gpt (getpoint "\nDiem can do: "))
(setq yg (cadr gpt))
(setq ddy (- yg yyy)
ddy (+ (* (/ tld 1000.00) ddy) cdg)
)
(princ (strcat "\n Cao do: " (rtos ddy 2 2)))
(setq elst (entget (car (entsel "\nGhi vao: "))))
(setq elst (subst (cons 1 (rtos ddy 2 2)) (assoc 1 elst) elst))
(entmod elst)
(print)
)
;***********GHI DO DOC************
(defun c:dd ()
(setq DZ (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq pt1 (getpoint "\nPick 1st point"))
(setq pt2 (getpoint "\nPick 2nd point" pt1))
(setq x1 (car pt1)
y1 (cadr pt1)
x2 (car pt2)
y2 (cadr pt2)
x (/ (+ x1 x2) 2)
y (/ (+ y1 y2) 2)
y (+ y (* 1.5 scale))
pt (list x y)
)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (> x2 x1)
(progn
(setq i (/ (* (- y1 y2) dd) (* (- x2 x1) nn))
i (strcat (rtos i 2 2) "%")
)
(princ (strcat "\n i%: " i))
(setq elst (entget (car (entsel "\nGhi do doc: "))))
(setq elst (subst (cons 1 i) (assoc 1 elst) elst))
(entmod elst)
)
(progn
(setq i (/ (* (- y1 y2) dd) (* (- x1 x2) nn))
i (strcat (rtos i 2 2) "%")
)
(princ (strcat "\n i%: " i))
(setq elst (entget (car (entsel "\nGhi do doc: "))))
(setq elst (subst (cons 1 i) (assoc 1 elst) elst))
(entmod elst)
)
)
(setvar "DIMZIN" DZ)
(setvar "OSMODE" OS)
)
;***********TRA LT , CD************
(defun C:tra ()
(setq gpt (getpoint "\nDiem can do: "))
(setq xg (car gpt) yg (cadr gpt))
(setq ddx (- xg xxx)
ddy (- yg yyy)
ddx (+ (* (/ tln 1000.00) ddx) ltg)
ddy (+ (* (/ tld 1000.00) ddy) cdg)
)
(alert (strcat "\n Cao do: " (rtos ddy 2 3) "\n Ly trinh: " (rtos ddx 2 3)))
)
;***********VE HUU CO************
(defun C:HC ()
(setq lalast (getvar "CLAYER"))
(setq oslast (getvar "OSMODE"))
(setq dy (* dd 0.2))
(command "layer" "n" "HUU-CO" "")
(command "layer" "c" "3" "HUU-CO" "")
(command "layer" "l" "dashed" "HUU-CO" "")
(command "layer" "s" "HUU-CO" "")
(setvar "OSMODE" 33)
(setq pt1 (getpoint "\nFrom : "))
(setq y1 (- (cadr pt1) dy))
(setq pt1 (list (car pt1) y1))
(setq pt2 (getpoint "To : "))
(while (/= pt2 nil)
(setq y2 (+ (cadr pt2) dy))
(setq pt2 (list (car pt2) y2))
(setvar "OSMODE" 0)
(command "line" pt1 pt2 "")
(setq pt1 pt2)
(setvar "OSMODE" 33)
(setq pt2 (getpoint "To : "))
)
(setvar "OSMODE" oslast)
(setvar "CLAYER" lalast)
);end of defun
;***********TINH DIEN TICH************
(defun c:are()
(setq dtl 0)
(setq ss (ssadd))
(setq oslast (getvar "OSMODE"))
(command "OSMODE" "0")
(print)
(if (not *InsT) (setq *InsT "R"))
(setq InsT (getstring (strcat "\nCreate or Replace TEXT? (C|R)<" *InsT ">: ")))
(if (= InsT "c") (setq InsT "C"))
(if (= InsT "r") (setq InsT "R"))
(if (= InsT "") (setq InsT *InsT) (setq *InsT InsT))
(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") 20 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(princ (strcat "\n" (rtos (/ dtcon tldn) 2 4) " Total: " (rtos (/ dtl tldn) 2 4)))
(print)
(setq pt1 (getpoint "\nPick internal point : "))
)
(setvar "OSMODE" oslast)
(command "erase" ss "")
(setq ss nil)
(command "redraw")
(setq dtl (/ dtl tldn))
(princ (strcat "\nTotal : " (rtos dtl 2 4) "\n" ))
(cond
((= InsT "R")
(setq elst (entget (car (entsel "\nTEXT to replace: "))))
(setq adtl (rtos dtl 2 2))
(setq elst (subst (cons 1 adtl) (assoc 1 elst) elst))
(entmod elst)
)
((= InsT "C")
(setq pt2 (getpoint "\nPoint to creat TEXT: "))
(command "text" pt2 "0" (rtos dtl 2 4) )
)
)
(print)
);defun
;*********** DO DOC ************
(defun c:dc ( / OS DZ pt1 pt2 pt x1 x2 y1 y2 y i ang )
(if (= scale nil)
(progn
(setq scale (getreal "\nInput current scale: "))
)
)
(setq DZ (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq pt1 (getpoint "\nPick 1st point"))
(setq pt2 (getpoint "\nPick 2nd point" pt1))
(setq x1 (car pt1)
y1 (cadr pt1)
x2 (car pt2)
y2 (cadr pt2)
x (/ (+ x1 x2) 2)
y (/ (+ y1 y2) 2)
y (+ y (* 1.5 scale))
pt (list x y)
)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (> x2 x1)
(progn
(setq i (/ (/ (- y1 y2) dd) (/ (- x2 x1) nn))
i (strcat (rtos (* i 100) 2 2) "%")
i (ustr 0 "Input i%: " i T)
ang (/ (* (angle pt1 pt2) 180) pi)
)
(command "INSERT" "ddoc" pt scale scale ang i)
)
(progn
(setq i (/ (/ (- y1 y2) dd) (/ (- x1 x2) nn))
i (strcat (rtos (* i 100) 2 2) "%")
i (ustr 0 "Input i%: " i T)
ang (/ (* (angle pt2 pt1) 180) pi)
)
(command "INSERT" "ddoc1" pt scale scale ang i)
)
)
(setvar "DIMZIN" DZ)
(setvar "OSMODE" OS)
)
;***********CHEN CAO DO************
(defun C:CA ()
(setq gpt (getpoint "\nPick Insertion Point")
ptside (getpoint "\nPick Side Point" gpt)
ang (angle gpt ptside)
)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq dz (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq xg (car gpt) yg (cadr gpt))
(setq ddx (- xg xxx)
ddy (- yg yyy)
ddx (+ (* (/ tln 1000.00) ddx) ltg)
ddy (+ (* (/ tld 1000.00) ddy) cdg)
)
(princ (strcat "\n Cao do: " (rtos ddy 2 2)))
(cond
((> ddy 0) (setq ddy (strcat "+" (rtos ddy 2 #acc))))
((< ddy 0) (setq ddy (rtos ddy 2 #acc)))
((= ddy 0) (setq ddy "%%p0.00"))
)
(if (AND (>= ang 0) (< ang 1.5708)) (command "INSERT" "CD" gpt scale scale "0" ddy))
(if (AND (>= ang 1.5708) (< ang 3.1416)) (command "INSERT" "CD3" gpt scale scale "0" ddy))
(if (AND (>= ang 3.1416) (< ang 4.7124)) (command "INSERT" "CD2" gpt scale scale "0" ddy))
(if (AND (>= ang 4.7124) (< ang 6.2832)) (command "INSERT" "CD1" gpt scale scale "0" ddy))
(setvar "OSMODE" OS)
(setvar "DIMZIN" dz)
(print)
)

  • 0
Tôi không phải là đặc biệt, nhưng tôi là duy nhất ^^

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 07 November 2011 - 09:14 AM

Bạn tiendung89 thân mến!
Ai mà lại 1 mình mình post liền 4 bài cùng 1 chủ đề như thế, còn đâu đất cho người khác sống?
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 tiendung89

tiendung89

    biết lệnh move

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

Đã gửi 07 November 2011 - 02:38 PM

sorry mọi người
em dùng 3G nên up bài mới lên cứ bị giật nó báo up bài ko thành công em cứ ngĩ chưa đc nên lại up lại do đó bị trùng lặp. mong mọi ng thông cảm
  • 0
Tôi không phải là đặc biệt, nhưng tôi là duy nhất ^^