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

Tháng 11 5, 2010

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 đỡ !

Tháng 11 5, 2010

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

Tháng 11 6, 2010

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 đỡ !

Tháng 11 6, 2010

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

Tháng 11 7, 2010

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é !

Tháng 11 7, 2010

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

Tháng 11 7, 2010

Tên ketxu nhí nhố này đc những 34 thank cơ đấy :)

share ta ít nào :D

Tháng 11 9, 2010

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.com/upfiles/3/san_nen.dwg

Bác chỉnh giúp em với !

Tháng 11 9, 2010

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.com/upfiles/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....

Tháng 11 9, 2010

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.com/upfiles/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 (	    (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)
 )
)
)

Tháng 11 9, 2010

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ỉ ???

Tháng 6 23, 2011

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!

Tháng 6 23, 2011

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

Tháng 6 23, 2011

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

Tháng 6 23, 2011

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

Tháng 6 23, 2011

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

Tháng 10 21, 2011

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 !

Tháng 10 21, 2011

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

Tháng 10 22, 2011

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=0entry115904
(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ì là 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)
 )
)
)

Tháng 10 22, 2011

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=0entry115904
(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ì là 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

Tháng 10 22, 2011

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

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=175482&st=0entry175482
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0entry115904
(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 :"))
(or *z1* (setq *z1* 10.0))
(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 :"))
(or *z2* (setq *z2* 10.0))
(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ì là getint ?
(or cao (setq cao 2)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu:  <" (vl-princ-to-string cao) " > :")))(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)
 )
)
)

hihi. Được 80% rùi ạ. Còn cái lưu giá trị số phần tử nằm giữa AB thì e thua rùi. vì nó là getint ? help me !

Tháng 10 22, 2011

hihi. Được 80% rùi ạ. Còn cái lưu giá trị số phần tử nằm giữa AB thì e thua rùi. vì nó là getint ? help me !

Để bạn tự làm cho mau lên tay. Ví dụ là:

(rtos a 2) ==> (itoa a)

Tháng 10 22, 2011

@Hanam : rất buồn là ngay trong lisp bạn post đã thừa đủ thử để bạn làm việc đó, bạn copy mà không chú ý đó thôi :

(or cao (setq cao 2)) ; 10 = Khoang cach mac dinh

(setq cao (cond ((getdist (strcat "\n chieu cao chu: <" (vl-princ-to-string cao) " > :")))(cao)))

Getint thì có khác gì ?

P/S : tại sao bạn vẫn tiếp tục việc tạo nick mới để hỏi ? Bạn ngại người khác biết bạn lười à ?

http://www.cadviet.com/forum/index.php?showtopic=56841&view=findpost&p=174086

Tháng 10 22, 2011

(setq m (getint (strcat "\n so phan tu " < " (itoa m) " >:"")) ) ???

Tháng 10 23, 2011

Còn một dòng mà e loay hoay đổi các kiểu nửa tiếng mà không được, Bác nào check lỗi giúp em với ạ !

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=175482&st=0entry175482
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0entry115904
(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 :"))
(or *z1* (setq *z1* 10.0))
(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 :"))
(or *z2* (setq *z2* 20.0))
(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)))
(or *m* (setq *m* 20.0))
(setq m (getint (strcat "\nSo phan tu <" (rtos m 2 0) ">: ")))  ;=> dong nay e chua sua duoc !
(if (not m) (setq m *m*) (setq *m* m))
;(setq m (getint (strcat "\n so phan tu " < " (itoa m) " >:"")) )
;(setq m (getint "\n So phan tu nam giua A va B  "(itoa m)" : ") i 0 ) ;

(or cao (setq cao 2)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu:  <" (vl-princ-to-string cao) " > :")))(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)
 )
)
)

Đăng nhập

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

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

hhhhgggg 29

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

Tue_NV 3.912

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

hhhhgggg 29

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

Tue_NV 3.912

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

hhhhgggg 29

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

ketxu 2.984

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

KS.PhanThanhTu 76

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

hhhhgggg 29

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

phamthanhbinh 3.146

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

Tue_NV 3.912

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

hhhhgggg 29

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 NGU 0

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

Doan Van Ha 3.191

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

ketxu 2.984

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

Doan Van Ha 3.191

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

ketxu 2.984

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

hanam1210 1

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

ketxu 2.984

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

nokia 0

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

Doan Van Ha 3.191