Đến nội dung


Hình ảnh
- - - - -

[Đã xong] Lisp copy text số, tăng theo hàm bậc nhất !


  • Please log in to reply
28 replies to this topic

#1 hhhhgggg

hhhhgggg

    biết dimedit

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

Đã gửi 05 November 2010 - 04:03 PM

Các bác Pro à. khi mình làm Hs, rất nhiều lúc, CĐTK của mình không bằng nhau. Nó biến thiên theo dạng hàm bậc nhất. E muốn có 1 lisp copy text mà tăng dần hoặc giảm dần. Cụ thể như sau: Text ban đầu tại A có giá trị a, tại B có giá trị b. Lisp sẽ copy text ( rải đều) tại A theo phương AB, với số lượng text là k mà ta nhập vào hoặc là nhập vào khoảng cách @ và giá trị chênh nhau giữa 2 text cạnh nhau . sao cho giá trị biến thiên đều theo dạng bậc nhất từ a tới b.( 2 text cạnh nhau sẽ chênh nhau m=(a- b ) /k . Các giá trị a, b do người dùng nhập vào . Mong các bác Pro quan tâm giúp đỡ !
  • 0
Hoàng Giang

#2 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 05 November 2010 - 04:52 PM

Các bác Pro à. khi mình làm Hs, rất nhiều lúc, CĐTK của mình không bằng nhau. Nó biến thiên theo dạng hàm bậc nhất. E muốn có 1 lisp copy text mà tăng dần hoặc giảm dần. Cụ thể như sau: Text ban đầu tại A có giá trị a, tại B có giá trị b. Lisp sẽ copy text ( rải đều) tại A theo phương AB, với số lượng text là k mà ta nhập vào hoặc là nhập vào khoảng cách @ và giá trị chênh nhau giữa 2 text cạnh nhau . sao cho giá trị biến thiên đều theo dạng bậc nhất từ a tới b.( 2 text cạnh nhau sẽ chênh nhau m=(a- b ) /k . Các giá trị a, b do người dùng nhập vào . Mong các bác Pro quan tâm giúp đỡ !

Hhhhgggg xem ở đây :
Lisp nội suy - Bài Viết số 1449
  • 0

#3 hhhhgggg

hhhhgggg

    biết dimedit

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

Đã gửi 06 November 2010 - 08:45 AM

Hhhhgggg xem ở đây :
Lisp nội suy - Bài Viết số 1449

Không đúng bác TueNV à. Lisp em muốn là chỉ nhập A(P1, Z1) ; B(P2, Z2) và nhập vào số lượng phần tử m hoặc là độ lệch giá trị của 2 phần tử cạnh nhau. Thì lisp sẽ tự động copy ra m phần tử nằm giữa AB, các giá trị của các phần tử đó thay đổi đều từ Z1 đến Z2. Mong các bác quan tâm giúp đỡ !
  • 0
Hoàng Giang

#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 06 November 2010 - 03:06 PM

Không đúng bác TueNV à. Lisp em muốn là chỉ nhập A(P1, Z1) ; B(P2, Z2) và nhập vào số lượng phần tử m hoặc là độ lệch giá trị của 2 phần tử cạnh nhau. Thì lisp sẽ tự động copy ra m phần tử nằm giữa AB, các giá trị của các phần tử đó thay đổi đều từ Z1 đến Z2. Mong các bác quan tâm giúp đỡ !

Lisp noisuy được sửa lại theo yêu cầu của bạn đây :

(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :"))
(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
(setq Z2 (getreal "\n Nhap cao do Z2 :"))
(if (> (cadr p1) (cadr p2))
(progn (setq ptg p2) (setq p2 p1) (setq p1 ptg)
(setq Ztg Z2) (setq Z2 Z1) (setq Z1 Ztg))
)
(setq dis (distance p1 p2)
ang (angle p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(setq m (getint "\n So phan tu nam giua A va B :") i 0)
(setq cao (getdist "\n Nhap chieu cao chu :"))
(Setq oldos (getvar "OSMODE"))
(SETVAR "OSMODE" 0)
(Repeat (+ m 2)
(setq p (polar p1 ang (* i (/ dis (1+ m)))))
(setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) ))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
(progn (setq Z (+ Z1 (* tana a))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) ))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
(progn (setq Z (+ Z2 (* tana a))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
)
)
(command "point" p)
(setq i (1+ i))
);while
(COMMAND "LINE" P1 P2 "")
(SETVAR "OSMODE" oldos)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq ang (- ang pi))
)
(entmake (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 1)
)
)
)

  • 2

#5 hhhhgggg

hhhhgggg

    biết dimedit

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

Đã gửi 07 November 2010 - 12:55 PM

Lisp noisuy được sửa lại theo yêu cầu của bạn đây :


(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :"))
(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
(setq Z2 (getreal "\n Nhap cao do Z2 :"))
(if (> (cadr p1) (cadr p2))
(progn (setq ptg p2) (setq p2 p1) (setq p1 ptg)
(setq Ztg Z2) (setq Z2 Z1) (setq Z1 Ztg))
)
(setq dis (distance p1 p2)
ang (angle p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(setq m (getint "\n So phan tu nam giua A va B :") i 0)
(setq cao (getdist "\n Nhap chieu cao chu :"))
(Setq oldos (getvar "OSMODE"))
(SETVAR "OSMODE" 0)
(Repeat (+ m 2)
(setq p (polar p1 ang (* i (/ dis (1+ m)))))
(setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) ))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
(progn (setq Z (+ Z1 (* tana a))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) ))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
(progn (setq Z (+ Z2 (* tana a))) (in (rtos Z 2 3) p cao (angle p1 p2)) )
)
)
(command "point" p)
(setq i (1+ i))
);while
(COMMAND "LINE" P1 P2 "")
(SETVAR "OSMODE" oldos)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq ang (- ang pi))
)
(entmake (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 1)
)
)
)

ok ! đúng rùi ! Cảm ơn bác nhìu nhìu nhé !
  • 1
Hoàng Giang

#6 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 07 November 2010 - 06:08 PM

Oh,sao các bạn ý thank nhiều thế mà diễn đàn hok có thống kê số lần thanks nhỉ ^^ Phải thế mới thể hiện uy tín của 1 member chứ :">

PS Ôi srr e nhìn nhầm,hình như có tại chỗ -* ^^ Nhưng mà hok xóa đc bài nữa r :)
  • 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


#7 KS.PhanThanhTu

KS.PhanThanhTu

    biết vẽ point

  • Members
  • PipPip
  • 97 Bài viết
Điểm đánh giá: 76 (tàm tạm)

Đã gửi 07 November 2010 - 06:38 PM

Tên ketxu nhí nhố này đc những 34 thank cơ đấy :)
share ta ít nào :D
  • 0
KS Phan Thanh Tú.Email: Vansulich@yahoo.com

#8 hhhhgggg

hhhhgggg

    biết dimedit

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

Đã gửi 09 November 2010 - 01:35 PM

Tên ketxu nhí nhố này đc những 34 thank cơ đấy :)
share ta ít nào :D

huhu. không được rùi bác Tuệ ơi ! Bác kiểm tra lại cái lisp nội suy giúp e đi. Khi em chạy thử ở 1 file mới thì nó chạy đúng. Nhưng khi chạy thực tế trong file San nền = HS thì nó chạy sai. ko đúng nữa. Nó bị ngược cao độ và không đúng. Bác có thể kiểm tra lại, E chạy trên HS ( CAD 2004 ). Chú ý rằng khi ta pick P1 ở bên trái, Z1 =2, P2 ở bên phải, Z2=10 thì có lúc chạy đúng. Nhưng ngược lại, khi P2=10 ở bên trái của P1 thì chạy sai.
Đây là file CAD: http://www.cadviet.c...s/3/san_nen.dwg
Bác chỉnh giúp em với !
  • 0
Hoàng Giang

#9 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 09 November 2010 - 03:18 PM

huhu. không được rùi bác Tuệ ơi ! Bác kiểm tra lại cái lisp nội suy giúp e đi. Khi em chạy thử ở 1 file mới thì nó chạy đúng. Nhưng khi chạy thực tế trong file San nền = HS thì nó chạy sai. ko đúng nữa. Nó bị ngược cao độ và không đúng. Bác có thể kiểm tra lại, E chạy trên HS ( CAD 2004 ). Chú ý rằng khi ta pick P1 ở bên trái, Z1 =2, P2 ở bên phải, Z2=10 thì có lúc chạy đúng. Nhưng ngược lại, khi P2=10 ở bên trái của P1 thì chạy sai.
Đây là file CAD: http://www.cadviet.c...s/3/san_nen.dwg
Bác chỉnh giúp em với !

Chào bạn hhhhgggg,
Bạn là thành viên khá kỳ cựu của diễn đàn, Theo mình nghĩ bạn hoàn toàn có khả năng chỉnh sửa cái lisp trên của bác Tue_NV cho đúng với yêu cầu sử dụng của bạn. Về trhua65t giải thì bác Tue_NV đã làm rồi, chỉ còn là chỉnh sửa một số trường hợp đặc biệt trong quá trình sủ dụng của bạn mà thôi. Mà thực tế thì cái đặc biệt này chỉ có bạn là người trực tiếp sử dụng mới có thể hình dung được hết mà thôi. Còn có thể bác Tue_NV cũng khó có thể lường hết mọi tình huống cho bạn được. Vì thế bạn hãy cố gắng tự chỉnh thì tốt hơn nhiều lần là phải ngồi chờ bạn ạ. Mà chưa chắc cái có được đã đáp ứng đầy đủ yêu cầu của bạn. Hãy chủ động lên, đừng thụ động như vậy....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#10 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 09 November 2010 - 03:23 PM

huhu. không được rùi bác Tuệ ơi ! Bác kiểm tra lại cái lisp nội suy giúp e đi. Khi em chạy thử ở 1 file mới thì nó chạy đúng. Nhưng khi chạy thực tế trong file San nền = HS thì nó chạy sai. ko đúng nữa. Nó bị ngược cao độ và không đúng. Bác có thể kiểm tra lại, E chạy trên HS ( CAD 2004 ). Chú ý rằng khi ta pick P1 ở bên trái, Z1 =2, P2 ở bên phải, Z2=10 thì có lúc chạy đúng. Nhưng ngược lại, khi P2=10 ở bên trái của P1 thì chạy sai.
Đây là file CAD: http://www.cadviet.c...s/3/san_nen.dwg
Bác chỉnh giúp em với !

Nó không đúng do Tung độ Y của p2 lớn hơn Tung độ Y của p1
Fix lỗi cho bạn đây :
Chú ý rằng Z2 của điểm p2 bao giờ cũng lớn hơn Z1 của điểm p1 nhé (Z2>Z1)
Bạn thử các trường hợp xem nhé. Chú ý điều kiện (Z2>Z1)

(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :") L '())
(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
(setq Z2 (getreal "\n Nhap cao do Z2 :"))

(setq dis (distance p1 p2)
ang (angle p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(setq m (getint "\n So phan tu nam giua A va B :") i 0)
(setq cao (getdist "\n Nhap chieu cao chu :"))
(Setq oldos (getvar "OSMODE"))
(SETVAR "OSMODE" 0)
(Repeat (+ m 2)
(setq p (polar p1 ang (* i (/ dis (1+ m)))))
(setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z1 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z2 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
(command "point" p)
(setq i (1+ i))
);while
(COMMAND "LINE" P1 P2 "")
(if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
(vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
) L (reverse L) )))
(SETVAR "OSMODE" oldos)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 1)
)
)
)

  • 1

#11 hhhhgggg

hhhhgggg

    biết dimedit

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

Đã gửi 09 November 2010 - 04:04 PM

Nó không đúng do Tung độ Y của p2 lớn hơn Tung độ Y của p1
Fix lỗi cho bạn đây :
Chú ý rằng Z2 của điểm p2 bao giờ cũng lớn hơn Z1 của điểm p1 nhé (Z2>Z1)
Bạn thử các trường hợp xem nhé. Chú ý điều kiện (Z2>Z1)


(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :") L '())
(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
(setq Z2 (getreal "\n Nhap cao do Z2 :"))

(setq dis (distance p1 p2)
ang (angle p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(setq m (getint "\n So phan tu nam giua A va B :") i 0)
(setq cao (getdist "\n Nhap chieu cao chu :"))
(Setq oldos (getvar "OSMODE"))
(SETVAR "OSMODE" 0)
(Repeat (+ m 2)
(setq p (polar p1 ang (* i (/ dis (1+ m)))))
(setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z1 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z2 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
(command "point" p)
(setq i (1+ i))
);while
(COMMAND "LINE" P1 P2 "")
(if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
(vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
) L (reverse L) )))
(SETVAR "OSMODE" oldos)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 1)
)
)
)


E mới check thì rất đúng . Để e dùng một thời gian xem có lỗi j không nhé. Cảm ơn bác nhìu nhìu. Bác thật là Pro, bán 1 ít cái Pro của bác đi ăn cả đời không hết nhỉ ???
  • 1
Hoàng Giang

#12 TÀO NGU

TÀO NGU

    biết pan

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

Đã gửi 23 June 2011 - 02:24 PM

Bác Tue_VN quả là cao thủ. Bác có thể giúp cho cái Lisp copy text số để có được một text số mới có giá trị bằng số của text gốc cộng với khoảng cách gữa hai điểm chèn của text gốc và text mới? rất cảm ơn!
  • 0

#13 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 23 June 2011 - 05:09 PM

Bác Tue_VN quả là cao thủ. Bác có thể giúp cho cái Lisp copy text số để có được một text số mới có giá trị bằng số của text gốc cộng với khoảng cách gữa hai điểm chèn của text gốc và text mới? rất cảm ơn!

Trong lúc bác Tue_NV đi vắng, bạn sử dụng tạm cái này xem sao:

(defun C:CTD (/ dt p1 p2 txcu txmoi kc tt1 tt2)
(setq dt (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Text ho\U+1EB7c Mtext..."))
(setq p1 (getpoint "\nV\U+00E0o \U+0111i\U+1EC3m g\U+1ED1c: "))
(setq p2 (getpoint p1 "\nV\U+00E0o \U+0111i\U+1EC3m \U+0111\U+1EBFn: "))
(setq txcu (atof (cdr (assoc 1 (entget (car dt))))))
(while p2
(setq kc (distance p1 p2))
(setq txmoi (rtos (+ kc txcu) 2))
(command ".copy" dt "" p1 p2)
(setq tt1 (entget (entlast)))
(setq tt2 (subst (cons 1 txmoi) (assoc 1 tt1) tt1))
(entmod tt2)
(entupd (entlast))
(setq p2 (getpoint p1 "\nV\U+00E0o \U+0111i\U+1EC3m \U+0111\U+1EBFn: "))))
(princ "\L\U+1EC7nh s\U+1EED d\U+1EE5ng: CTD")

  • 2

* 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.


#14 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 June 2011 - 05:44 PM

Trong lúc bác Tue_NV đi vắng, bạn sử dụng tạm cái này xem sao:

Theo em thì sau khi hoàn thiện nên loại bỏ các biến chỉ dùng 1 lần trong code. Kiểu như :

(defun C:CTD (/ dt p1 p2)
(setq dt (entget (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Text ho\U+1EB7c Mtext...")))
p1 (acet-dxf 10 dt))
(while (setq p2 (getpoint p1 "\nV\U+00E0o \U+0111i\U+1EC3m \U+0111\U+1EBFn: "))
(command ".copy" (acet-dxf -1 dt) "" p1 p2)
(vla-put-textstring (vlax-ename->vla-object (entlast)) (rtos (+ (distance p1 p2) (atof (acet-dxf 1 dt))) 2))
))

  • 4

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


#15 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 23 June 2011 - 10:21 PM

Theo em thì sau khi hoàn thiện nên loại bỏ các biến chỉ dùng 1 lần trong code.

Ket chơi kiểu hàn lâm quá. DVH chơi kiểu hai lúa nên nó hơi dài vậy mà.
  • 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.


#16 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 23 June 2011 - 10:35 PM

Thì khi viết một cái mới, e cũng sẽ làm thế, n sau khi ổn r, thì bỏ những biến trung gian không cần thiết đi thôi ^^
  • 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


#17 hanam1210

hanam1210

    biết vẽ pline

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

Đã gửi 21 October 2011 - 07:58 PM

E mới check thì rất đúng . Để e dùng một thời gian xem có lỗi j không nhé. Cảm ơn bác nhìu nhìu. Bác thật là Pro, bán 1 ít cái Pro của bác đi ăn cả đời không hết nhỉ ???

Cái lisp noisuy của a KETXU viết đúng là cái em cần. Em đã thử sửa code để thêm tính năng lưu giá trị cao text và số phần tử của lần nhập trước nhưng không được. Để hoàn thiện hơn thì mình thêm 2 tính năng đó sẽ tiện hơn. Phiền a bổ sung cho anh em dùng ạ ! Cảm ơn anh nhiều !
  • 0

#18 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 October 2011 - 12:06 AM

Trong những lisp viết theo yêu cầu của bạn đã có hàng đống cái có lưu giá trị nhập lần trước, bạn hãy vẫn động đi :) Bạn không rút ra được điều gì sau topic gần đây sao ??
http://www.cadviet.c...opic=56841&st=0
  • 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


#19 nokia

nokia

    biết pan

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

Đã gửi 22 October 2011 - 07:36 AM

Trong những lisp viết theo yêu cầu của bạn đã có hàng đống cái có lưu giá trị nhập lần trước, bạn hãy vẫn động đi :) Bạn không rút ra được điều gì sau topic gần đây sao ??
http://www.cadviet.c...opic=56841&st=0

hi. Bác mắng em cũng đúng. Quả thật thì e đã bê cái lưu giá trị lần trước vào rồi nhưng nó không chạy nên e phải nhờ bác. hức hức. Tang chứng vật chứng vẫn còn đây ạ , chú ý rằng e chỉ copy paste và đổi tên biến chứ e ko hiểu nhìu về lisp đâu ạ.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0&#entry115904
(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :") L '())
;(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(setq z1 (getreal (strcat "\nCao do Z1 <" (rtos *z1* 2) ">: ")))
(if (not z1) (setq z1 *z1*) (setq *z1* z1))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
; (setq Z2 (getreal "\n Nhap cao do Z2 :"))
(setq z2 (getreal (strcat "\nCao do Z2 <" (rtos *z2* 2) ">: ")))
(if (not z2) (setq z2 *z2*) (setq *z2* z2))
(setq dis (distance p1 p2)
ang (angle p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(setq m (getint "\n So phan tu nam giua A va B :") i 0) ; => em khong biet bo sung luu gia tri, v&#236; l&#224; getint ?
(or cao (setq cao 10)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu: <" (vl-princ-to-string #dist) " > :")))(cao)))
; (setq cao (getdist "\n Nhap chieu cao chu :")) ;
(Setq oldos (getvar "OSMODE"))
(SETVAR "OSMODE" 0)
(Repeat (+ m 2)
(setq p (polar p1 ang (* i (/ dis (1+ m)))))
(setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z1 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z2 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
(command "point" p)
(setq i (1+ i))
);while
(COMMAND "LINE" P1 P2 "")
(if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
(vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
) L (reverse L) )))
(SETVAR "OSMODE" oldos)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 1)
)
)
)


  • 0

#20 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 22 October 2011 - 08:05 AM

hi. Bác mắng em cũng đúng. Quả thật thì e đã bê cái lưu giá trị lần trước vào rồi nhưng nó không chạy nên e phải nhờ bác. hức hức. Tang chứng vật chứng vẫn còn đây ạ , chú ý rằng e chỉ copy paste và đổi tên biến chứ e ko hiểu nhìu về lisp đâu ạ.


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0&#entry115904
(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :") L '())
;(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(setq z1 (getreal (strcat "\nCao do Z1 <" (rtos *z1* 2) ">: ")))
(if (not z1) (setq z1 *z1*) (setq *z1* z1))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
; (setq Z2 (getreal "\n Nhap cao do Z2 :"))
(setq z2 (getreal (strcat "\nCao do Z2 <" (rtos *z2* 2) ">: ")))
(if (not z2) (setq z2 *z2*) (setq *z2* z2))
(setq dis (distance p1 p2)
ang (angle p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(setq m (getint "\n So phan tu nam giua A va B :") i 0) ; => em khong biet bo sung luu gia tri, v&#236; l&#224; getint ?
(or cao (setq cao 10)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu: <" (vl-princ-to-string #dist) " > :")))(cao)))
; (setq cao (getdist "\n Nhap chieu cao chu :")) ;
(Setq oldos (getvar "OSMODE"))
(SETVAR "OSMODE" 0)
(Repeat (+ m 2)
(setq p (polar p1 ang (* i (/ dis (1+ m)))))
(setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z1 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z2 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
(command "point" p)
(setq i (1+ i))
);while
(COMMAND "LINE" P1 P2 "")
(if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
(vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
) L (reverse L) )))
(SETVAR "OSMODE" oldos)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 1)
)
)
)

Cần phải thêm dòng
(or *z1* (setq *z1* 10.0))
Vào trên dòng
(setq z1...
Tương tự với z2
  • 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.