Viết Lisp theo yêu cầu

[truongliem0902 0]

các bác có ai biết thì giúp gium với. tui cần một lisp như sau

cập nhật số nhà liên tục giống như lệnh CT ( viết số liên tục ) nhưng lệnh này chỉ cho ra số tự nhiên. không cho ra số A/b vd như 194/37, 194/37/4 .... mong các bác chỉ giùm

[duy782006 1.533]

các bác có ai biết thì giúp gium với. tui cần một lisp như sau

cập nhật số nhà liên tục giống như lệnh CT ( viết số liên tục ) nhưng lệnh này chỉ cho ra số tự nhiên. không cho ra số A/b vd như 194/37, 194/37/4 .... mong các bác chỉ giùm

-Bạn cứ dùng lệnh CT với các số sau cùng như bình thường sau đó dùng lisp sau:

-Tên lệnh CTT

-Tác Dụng: thêm 1 nội dung do bạn nhập vào trước và sau các text bạn chọn. với trường hợp của bạn thì khi hỏi nội dung them vào phía sau bạn nhấn enter.

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

(defun c:ctt (/ c e ss txt cmde ttdangs ttdangt)

(setq cmde (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

(setq ttdangt (getstring 5"\nChuoi muon them phia truoc:"))

(setq ttdangs (getstring 5"\nChuoi muon them phia sau:"))

(if (null ttdangt)(setq ttdangt ""))

(if (null ttdangs)(setq ttdangs ""))

(prompt "\nChon chu muon chinh.")

(setq ss (ssget))

(setq c 0)

(if ss (setq e (ssname ss c)))

(while e

(setq e (entget e))

; Ensure entity is text

(if (= (cdr (assoc 0 e)) "TEXT")

(progn

(setq txt (strcat ttdangt (cdr (assoc 1 e)) ttdangs))

(setq e (subst (cons 1 txt) (assoc 1 e) e))

(entmod e)

)

)

(setq c (1+ c)) ; Increment counter.

(setq e (ssname ss c)) ; Obtain next entity.

)

(setvar "CMDECHO" cmde)

(Prin I)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[chuottui84 0]

Bác Nguyen Hoanh ơi! Bác giúp em cái lisp về trường hợp này dc không bác

-Em muốn vẽ đường giao thông gồm: tim đường (layer1),lề dường (layer2) và đường (layer3).

khi chạy file lisp, chọn tim đường,gán layer cho tim đường, sau đó sẽ hỏi chiều rộng lòng đườg,gán layer chiều rộng lề đường, gán layer.

Nó gần jống như lệnh mline của cad, nhưng lệnh mline kô cho mình thay đổi layer riêng của từng loại đường.

Bác Nguyen Hoanh xem xét júp dùm e. Thanks bác nhiều nhiều!!!!

[tdv 0]

Có Bác nào có Cái Lisp Thiết lập Bản vẽ theo các khổ in A4...A0 và tự động tạo các layer, text hay có một bản Cad mẫu đã thiết lập sẵn các thông số trên không post lên cho em em xin. Thanks các Bác nhiều nhiều .........

[chuottui84 0]

hic hic Bac Hoanh Bác không giúp em àh

co anh em nao giup minh ko

[cuongtk2 336]

hic hic Bac Hoanh Bác không giúp em àh

co anh em nao giup minh ko

 

Để biến 1 đường thành 5 đường offset thì làm được, quá dễ.

Để biến 1 tim đường thành 1 entyti gồm 5 đuờng như Mline thì không thể dùng lisp để tạo được.

[VNPT_Killer 1]

Anh Hoành vui lòng viết giúp em lệnh lisp phá vỡ Block Attribute mà không làm thay đổi giá trị text trong Block nha!

Cụ thể như sau :

- Chạy list (tên lệnh do người viết tùy ý đặt)

- List yêu cầu chọn block Attribute (có 2 cánh chọn : Pick chuột vào từng Block Attribute hoặc kéo khối chọn cùng lúc nhiều Block Attribute )

- List sẽ phá vở Block Attribute mà không làm thay đổi giá trị text trong các Block Attribute đó.

 

Em có đính kèm file ví dụ theo nè anh!

http://www.cadviet.com/upfiles/Vi_du_01.dwg

[Nguyen Hoanh 4.663]

Anh Hoành vui lòng viết giúp em lệnh lisp phá vỡ Block Attribute mà không làm thay đổi giá trị text trong Block nha!

Cụ thể như sau :

- Chạy list (tên lệnh do người viết tùy ý đặt)

- List yêu cầu chọn block Attribute (có 2 cánh chọn : Pick chuột vào từng Block Attribute hoặc kéo khối chọn cùng lúc nhiều Block Attribute )

- List sẽ phá vở Block Attribute mà không làm thay đổi giá trị text trong các Block Attribute đó.

 

Em có đính kèm file ví dụ theo nè anh!

http://www.cadviet.com/upfiles/Vi_du_01.dwg

Bạn hãy sử dụng lệnh BURST của Express Tool có sẵn trong AutoCAD.

[ngayve324 270]

Bạn có thể post yêu cầu về autolisp ở topic này.

có thể giúp em cái lisp này với

yêu cầu thế này:

có nhiều TEXT trong bản vẽ, bây giờ em cần edit các text đó, khi edit xong thì text nào được edit được đổi màu (có thể màu mặc định của lisp chọn hay màu hiện hành bản vẽ)

Điều này có lợi khi sữa một bãn vẽ ta biết được text nào đã được sữa, text nào chưa.

cấm ơn bác trước

[Nguyen Hoanh 4.663]

có thể giúp em cái lisp này với

yêu cầu thế này:

có nhiều TEXT trong bản vẽ, bây giờ em cần edit các text đó, khi edit xong thì text nào được edit được đổi màu (có thể màu mặc định của lisp chọn hay màu hiện hành bản vẽ)

Điều này có lợi khi sữa một bãn vẽ ta biết được text nào đã được sữa, text nào chưa.

cấm ơn bác trước

lệnh là CTE (Color Text Edit)

(defun c:CTE()
 (setq ent (car (entsel "\nVao doi tuong text can sua: ")))
 (command ".ddedit" ent "")
 (command ".chprop" ent "" "c" "1" "")
 (princ)
)

Bạn có thể sửa số 1 (màu đỏ) trong đoạn mã trên thành các màu khác.

[dvdcad 1]

các bác cho em hỏi.

 

mở một bản vẽ cad chọn tỷ lệ ví dụ chọn tỷ lệ 1/500

làm thế nào để cái 1/500 nó hiện ở góc dưới của màn hình bản vẽ(ở bên phải của cursor coordinate values"F6")

 

bác nào có lisp làm dc việc này post cho em coi với

[Nguyen Hoanh 4.663]

các bác cho em hỏi.

 

mở một bản vẽ cad chọn tỷ lệ ví dụ chọn tỷ lệ 1/500

làm thế nào để cái 1/500 nó hiện ở góc dưới của màn hình bản vẽ(ở bên phải của cursor coordinate values"F6")

 

bác nào có lisp làm dc việc này post cho em coi với

Phụ thuộc vào bạn quan niệm thế nào là 1/500

[dvdcad 1]

Phụ thuộc vào bạn quan niệm thế nào là 1/500

ko hiểu ý bác nguyen hoanh. em chỉ muốn khi em chọn tỷ lệ 1/ 500 thì nó thể hiện lên để em biết thôi

[Nguyen Hoanh 4.663]

ko hiểu ý bác nguyen hoanh. em chỉ muốn khi em chọn tỷ lệ 1/ 500 thì nó thể hiện lên để em biết thôi

Ý mình là làm thế nào để máy tính biết bạn đang vẽ 1/500?

[ph168xd 313]

Đã từng nghe qua lish này nhưng không nhớ ở đâu.

Em cần lish. tìm toạ độ của các điểm khi biết gốc toạ độ

Thực hiện lệnh.

lệnh tắt>chọn điểm làm gốc toạ độ, lish sẽ hiểm thị luôn (0,0) ngay bên cạnh vị trí đó.

Tiếp tục pick điểm. Lish sẽ ghi luôn toạ độ của điểm đó so với gốc (0,0) vừa chọn tại vị trí đó

Font chữ mặc định là chhbg.shx với chiều cao là 220.

Thanks các Bác nhìu

[Nguyen Hoanh 4.663]

Đã từng nghe qua lish này nhưng không nhớ ở đâu.

Em cần lish. tìm toạ độ của các điểm khi biết gốc toạ độ

Thực hiện lệnh.

lệnh tắt>chọn điểm làm gốc toạ độ, lish sẽ hiểm thị luôn (0,0) ngay bên cạnh vị trí đó.

Tiếp tục pick điểm. Lish sẽ ghi luôn toạ độ của điểm đó so với gốc (0,0) vừa chọn tại vị trí đó

Font chữ mặc định là chhbg.shx với chiều cao là 220.

Thanks các Bác nhìu

bạn nghe trong giấc mơ? lisp này chưa từng có trên cadviet.

 

đây là lisp tôi vừa viết theo yêu cầu của bạn, tên lệnh là TDD (tọa độ điểm) và TDG (tọa độ gốc):

(defun c:tdd()
 (if (null dgoc)
(progn
  (alert "Chua co diem goc, ban hay chon diem goc")
  (c:tdg)
)
(while (setq p (getpoint "\nVao diem: "))
  (ctxt p)
)
 )
 (princ)
)
(defun c:tdg()
 (setq dgoc (getpoint "\nVao diem goc: "))
 (ctxt dgoc)
 (princ)
)
(defun ctxt(p)
 (setq lst (mapcar 'rtos (mapcar '- p dgoc))
gt (strcat (car lst)","(cadr lst))
 )
 (entmake (list (cons 0 "TEXT") (cons 10 (trans p 1 0)) (cons 1 gt) (cons 40 220)))
)

[traitimsat034 15]

anh viết cho em xin một lisp nội suy cao độ từ text cao độ điểm.

- cao độ cơ sở để nội suy dưới dạng text ( cao độ bằng giá trị text, toạ độ trùng với điểm chèn text)

- cú pháp lệnh: khi nhập lệnh chương trình sẽ yêu cầu chọn điểm cần nội suy sau đó sẽ yêu cầu chọn ít nhất 3 text cao độ cơ sở để nội suy

- kết quả được ghi ra text (text kết quả lấy textstyle hiện hành, có điểm chèn trùng với điểm cần nội suy, có thể căn trái, phải, giữa tuỳ người viết)

em cám ơn anh!

[Nguyen Hoanh 4.663]

anh viết cho em xin một lisp nội suy cao độ từ text cao độ điểm.

- cao độ cơ sở để nội suy dưới dạng text ( cao độ bằng giá trị text, toạ độ trùng với điểm chèn text)

- cú pháp lệnh: khi nhập lệnh chương trình sẽ yêu cầu chọn điểm cần nội suy sau đó sẽ yêu cầu chọn ít nhất 3 text cao độ cơ sở để nội suy

- kết quả được ghi ra text (text kết quả lấy textstyle hiện hành, có điểm chèn trùng với điểm cần nội suy, có thể căn trái, phải, giữa tuỳ người viết)

em cám ơn anh!

Phù, phải mất công quay lại hình học giải tích lớp 12 để tính toán mãi mới có được các công thức nội suy.

 

Lệnh NS (nội suy) dưới đây sẽ thực hiện điều bạn muốn. Nội suy cao độ của 1 điểm dựa vào tọa độ của 3 điểm cho trước.

(defun getZ (p0 p1 p2 p / vta vtb x0 y0 z0 x1 y1 z1 x2 y2 z2 x y A B C)
 (setq
   p	(list (car p) (cadr p))
   vta	(mapcar '- p1 p0)
   vtb	(mapcar '- p2 p0)
 )
 (mapcar 'set
  '(x0 y0 z0 x1 y1 z1 x2 y2 z2 x y)
  (append p0 vta vtb p)
 )
 (setq
   A (- (* y1 z2) (* y2 z1))
   B (- (* z1 x2) (* z2 x1))
   C (- (* x1 y2) (* x2 y1))
 )
 (/ (- (+ (* A x0) (* B y0) (* C z0)) (+ (* A x) (* B y))) C)
)

(defun c:ns (/ ss3 pgoc lste tt)
 (princ "\nChon 3 text dau tien: ")
 (setq ss3 (ssget '((0 . "TEXT"))))
 (if (/= (sslength ss3) 3)
   (alert (strcat "\nBan vua chon " (itoa (sslength ss3)) " text\nban can phai chon 3 text"))
   (progn
     (setq
pgoc (trans (getpoint "\nVao diem noi suy: ") 1 0)
lste (mapcar 'ssname (list ss3 ss3 ss3) '(0 1 2))
tt   (entget (car lste))
lste (mapcar '(lambda (e)
		(setq tt (entget e)
		      p	 (cdr (assoc 10 tt))
		      gt (atof (cdr (assoc 1 tt)))
		)
		(reverse (cons gt (cdr (reverse p))))
	      )
	     lste
     )
     )
     (mapcar 'set '(p0 p1 p2) lste)
     (setq tt (subst (cons 10 pgoc) (assoc 10 tt) tt)
    tt (subst (cons 1 (rtos (getz p0 p1 p2 pgoc))) (assoc 1 tt) tt)
     )
     (entmake tt)
   )
 )
)

[traitimsat034 15]

Phù, phải mất công quay lại hình học giải tích lớp 12 để tính toán mãi mới có được các công thức nội suy.

 

Lệnh NS (nội suy) dưới đây sẽ thực hiện điều bạn muốn. Nội suy cao độ của 1 điểm dựa vào tọa độ của 3 điểm cho trước.

(defun getZ (p0 p1 p2 p / vta vtb x0 y0 z0 x1 y1 z1 x2 y2 z2 x y A B C)
 (setq
   p	(list (car p) (cadr p))
   vta	(mapcar '- p1 p0)
   vtb	(mapcar '- p2 p0)
 )
 (mapcar 'set
  '(x0 y0 z0 x1 y1 z1 x2 y2 z2 x y)
  (append p0 vta vtb p)
 )
 (setq
   A (- (* y1 z2) (* y2 z1))
   B (- (* z1 x2) (* z2 x1))
   C (- (* x1 y2) (* x2 y1))
 )
 (/ (- (+ (* A x0) (* B y0) (* C z0)) (+ (* A x) (* B y))) C)
)

(defun c:ns (/ ss3 pgoc lste tt)
 (princ "\nChon 3 text dau tien: ")
 (setq ss3 (ssget '((0 . "TEXT"))))
 (if (/= (sslength ss3) 3)
   (alert (strcat "\nBan vua chon " (itoa (sslength ss3)) " text\nban can phai chon 3 text"))
   (progn
     (setq
pgoc (trans (getpoint "\nVao diem noi suy: ") 1 0)
lste (mapcar 'ssname (list ss3 ss3 ss3) '(0 1 2))
tt   (entget (car lste))
lste (mapcar '(lambda (e)
		(setq tt (entget e)
		      p	 (cdr (assoc 10 tt))
		      gt (atof (cdr (assoc 1 tt)))
		)
		(reverse (cons gt (cdr (reverse p))))
	      )
	     lste
     )
     )
     (mapcar 'set '(p0 p1 p2) lste)
     (setq tt (subst (cons 10 pgoc) (assoc 10 tt) tt)
    tt (subst (cons 1 (rtos (getz p0 p1 p2 pgoc))) (assoc 1 tt) tt)
     )
     (entmake tt)
   )
 )
)

hì, cám ơn anh nhiều lắm. anh nhiệt tình quá. cám ơn anh thêm lần nữa!!!!!!

[meohoang 344]

Xin nhờ bác Nguyễn Hoành chỉnh lại lisp C:MTP vì khi chọn nhiều đối tượng cặp "TEXT - POINT" thì vị trí text và point không khớp nhau.

Cụ thể : text ghi 413.25 point có Z=413.25 phải trùng nhau. Lisp của bác chọn từng cặp thì được nhưng nhiều cặp là bị loạn xà bần

Cám ơn bác trước nhé

[Nguyen Hoanh 4.663]

Xin nhờ bác Nguyễn Hoành chỉnh lại lisp C:MTP vì khi chọn nhiều đối tượng cặp "TEXT - POINT" thì vị trí text và point không khớp nhau.

Cụ thể : text ghi 413.25 point có Z=413.25 phải trùng nhau. Lisp của bác chọn từng cặp thì được nhưng nhiều cặp là bị loạn xà bần

Cám ơn bác trước nhé

Tại sao nhỉ?

 

Khẳng định với bạn 2 điều:

- Không thể tối ưu lisp đó được nữa vì nó đã quá tối ưu.

- Lisp này dành để chọn một loạt đối tượng chứ không phải chọn theo cặp.

 

Tôi cũng đã test, mọi người dùng cũng không sao.

 

Có 2 khả năng:

1. Mật độ điểm của bạn quá lớn, khoảng cách các điểm quá bé so với kích thước text.

2. Text của bạn Justify không phải là Left.

 

Bạn có thể upload file của bạn lên diễn đàn được không?

[cuongtk2 336]

C­­­hưa đọc hết đã thấy lỗi ở hàm while rồi.

Cấu trúc của nó là

(while (điều kiện cần để chạy vòng lặp, ở đây là nhập toạ độ điểm)

(biểu thức)

); end while.

 

Ở đoạn code của bạn mình thấy sau while là luuos, khi giá trị này nil thì vòng lặp mới kết thúc.

Bạn nên để vòng lặp như sau:

(while

(setq p1 (getpoint .....))

(progn

(luuos)

(.....)

(.....)

); end progn

)end while

Như vậy khi nào không nhập điểm nữa thì vòng lặp sẽ kết thúc. Chúc may mắn

[Arch_Cuong 0]

Anh Hoành có thể viết cho e mấy lisp thế này đc không :

-Lisp trừ text : Sau khi chọn 2 text để trừ.(text trước là số bị trừ)->chọn điểm đặt in kết quả->in kết quả lên bản vẽ(text style của kết quả giống 2 text kia. có in ra dấu - nếu kết quả âm)

-Lisp tính giá trị trung bình : chọn các text, sau đó chương trình tự nhận biết có bao nhiêu text đã đc chọn và tính giá trị trung bình cho tổng các số đó.->chọn điểm in ra kết quả-> in kết quả lên bản vẽ.

-Lisp chèn text vào 1 text khác : chọn các text cần sửa-> nhập nội dung cần thêm vào-> chương trình sẽ tự động thêm vào trước các text cần sửa các text mà mình vừa nhập nội dung vào.

Cám ơn a rất nhiều . E làm về san nền nên cần mấy thứ này lắm.

[duy782006 1.533]

-Lisp chèn text vào 1 text khác : chọn các text cần sửa-> nhập nội dung cần thêm vào-> chương trình sẽ tự động thêm vào trước các text cần sửa các text mà mình vừa nhập nội dung vào.

Cám ơn a rất nhiều . E làm về san nền nên cần mấy thứ này lắm.

Bạn quay lại trước đây 1 trang mình có cái lisp làm việc này rồi. Cái lisp màu da cam đó bạn

[thangkho 0]

cho em hỏi có lisp nào chuyển Dtext có giá trị dương thành giá trị âm không. ví dụ: 2 chuyển thành -2