Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
hhhhgggg

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

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

hhhhgggg    30

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

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

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    30

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

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

  • Vote tăng 2

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

  • Vote tăng 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.649

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

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

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

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

  • Vote tăng 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
hhhhgggg    30
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ỉ ???

  • Vote tăng 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
TÀO NGU    0

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!

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    2.676

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

  • Vote tăng 2

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

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

  • Vote tăng 4

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    2.676

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

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

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

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

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 !

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

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

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

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

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    2.676

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

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

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 !

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    2.676

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)

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

@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

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    30

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

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 một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×