Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

[Doan Van Ha 3.201]

Sao bác Tue_NV trích dẫn được code của Tr.CongSon mà em thì chẳng thấy code trong bài viết của Tr.CongSon nhỉ (bài #2651 và #2653)?

cứ vào trả lời là nó lòi ra. Cadviet dạo này chơi chiêu mà

[quocmanh04tt 635]

Vậy hả Bác, để em thử xem sao. Cám ơn bác.

[quocmanh04tt 635]

Xem có thấy gì không ???

 

Cảm ơn a quocmanh04tt

Tối qua về mày mò ra cũng giống như a vậy,code em dùng:

(setq ent (entsel"\Chon Text trong Block ATT can Edit:")

               p1 (cadr ent)

               e2 (car (nentselp p1)));;chỗ này có thể dùng (ssget point '((0 . "INSERT"))) cũng được

 

Màu xanh: Giờ mới đọc cmt của anh , nên em sẽ thử xem sao,em code có chỗ nào vướng mắc em sẽ post hỏi tiếp ạ

 

@a pphung : Em cảm ơn nhưng cái này không phải cái em cần anh ơi,vì em muốn Edit trực tiếp chỗ cái Text của Block ATT cho dễ thẫy ấy mà

@Tr.CongSon tham khảo:

(defun c:eda (/ a-ent data ent n-ent obj text_temp)

(if(setq ent (entsel))(progn

(setq a-ent (nentselp (cadr ent)))

(setq n-ent (entget (car a-ent)))))

(if (eq (cdr (assoc 0 n-ent)) "ATTRIB")

(progn (setq obj (vlax-ename->vla-object (car a-ent)))

(setq data (cons '(0 . "TEXT") (vl-remove-if-not '(lambda (x) (member (car x) '(1 7 8 10 41 40 50 62))) n-ent))) ;Lay tinh chat cua Text trong tag

(vla-put-visible obj :vlax-false) ; An Tag

(entmakex data) ; Tao text tam thoi

(setq text_temp (entlast))

(if (< (atof (substr (getvar "acadver") 1 4)) 17.2)

(vl-cmdf "_.DDEDIT" text_temp "")

(vl-cmdf "_.TEXTEDIT" text_temp))

(vla-put-visible obj :vlax-true) ; Hien tag

(vla-put-textstring obj (cdr (assoc 1 (entget text_temp)))) ; Gan noi dung moi cho tag

(entdel text_temp))) ; Xoa text tam

(princ))

[Tr.CongSon 42]

Xem có thấy gì không ???

 

@Tr.CongSon tham khảo:

 

Hi.Giờ mới đọc comment của a.Cảm ơn anh nhiều (Like This)

Em viết hồi sáng giờ cũng được chừng ni rồi,Khi chạy từng đoạn thì được nhưng chạy tổng hết lệnh thì nó không được ak

ANh chị check giúp em với

 

; GetAtt - Reads all attribute values from a block

; Copyright: ;#169;2000 MENZI ENGINEERING GmbH, Switzerland

; Arguments [Type]:

; Obj = Object [VLA-OBJECT]

; Return [Type]:

; > Dotted pair list '(("Tag1" . "Val1")...)

(defun GetAtt (obj)

(mapcar '(lambda (att) (cons (vla-get-TagString att) (vla-get-TextString att)))

(vlax-invoke obj 'GetAttributes)

)

)

;;;----------------------------------------

(defun SetAtt (obj lst / attval)

(mapcar '(lambda (att)

(if (setq attval (cdr (assoc (vla-get-TagString att) lst)))

(vla-put-TextString att attval)

)

)

(vlax-invoke obj 'GetAttributes)

)

(vla-update obj)

)

;;;----------------------------------------

 

(defun T_Weight (Phi TongDai)

 

(/ (* pi (expt Phi 2) 7850 TongDai) (* 4 (expt 10 6))) ;phi=mm,TongDai=m

)

(defun T_Len1T (lstlen)

 

(apply '+ (mapcar '(lambda (x) (atoi (cdr x))) lstlen));lstlen=m

)

;;;----------------------------------------

; Lay ma Dxf cua doi tuong

(defun GetDxf(n elist) (cdr (assoc n elist)))

;;;----------------------------------------

(defun TS:Change_ATT (objblk objatt / 1ck cd1t dia lstatt lstdk lstkt newvalue sock tag tcd tl tst

val)

 

(setq LstATT (Getatt ObjBLK)

Tag (vla-get-TagString ObjATT)

Val (vla-get-TextString ObjATT)

Dia (atoi (substr (GetDxf "DK" LstATT) 4))

)

(cond

((wcmatch Tag "KT*")

(setq lstKT (vl-remove-if-not

'(lambda (x)

(and (wcmatch (car x) "KT*")

(/= (cdr x) "")

)

)

LstATT

)

lstKT (subst (cons Tag NewValue) (assoc Tag lstKT) lstKT)

CD1T (T_Len1T lstKT)

TCD (* CD1T (distof (GetDxf "TST" LstATT)) 10e-4)

TL (T_Weight Dia TCD)

lstUp (append lstKT (mapcar '(lambda (a B) (cons a B))

(list "CD1T" "TCD" "TL")

(list (itoa CD1T) (rtos TCD 2 2) (rtos TL 2 2))))

)

)

((wcmatch Tag "DK")

(setq Dia (atoi NewValue)

lstDK (cons Tag (strcat "%%c" NewValue))

TCD (GetDxf "TCD" LstATT)

TL (T_Weight Dia (atof TCD))

lstUp (mapcar '(lambda (a B) (cons a B))

(list Tag "TCD" "TL")

(list (strcat "%%c" NewValue) TCD (rtos TL 2 2)))

)

)

((wcmatch Tag "1T")

(initget 7)

(setq SoCK (getint "\nNh\U+1EADp S\U+1ED1 C\U+1EA5u Ki\U+1EC7n : "))

(setq 1CK (cons Tag NewValue)

TST (* SoCK (atoi NewValue))

CD1T (atoi (GetDxf "CD1T" LstATT))

TCD (* CD1T TST 10e-4)

TL (T_Weight Dia TCD)

lstUp (mapcar '(lambda (a B) (cons a B))

(list Tag "TST" "TCD" "TL")

(list NewValue (itoa TST) (rtos TCD 2 2) (rtos TL 2 2))

)

)

)

)

(SetAtt ObjBLK lstUp)

)

 

 

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

(defun c:STK (/ SelATT)

 

(setvar "CMDECHO" 0)

(defun TS:STK (Selent / entatt lsttemp newvalue objatt objblk txttemp)

(setq ObjBLK (vlax-ename->Vla-Object (car Selent))

EntATT (car (nentselp (cadr Selent)))

ObjATT (vlax-ename->Vla-Object EntATT)

Lsttemp (vl-remove-if-not

'(lambda (pair)

(member (car pair) (list 7 8 10 40 67 1))

)

(entget EntATT)

)

)

(if (vlax-property-available-p ObjATT 'Visible)

(vlax-put ObjATT 'Visible 0)

)

(setq TxtTemp (entmakex

(append (list '(0 . "TEXT")

'(100 . "AcDbEntity")

'(100 . "AcDbText")

)

Lsttemp

)

)

)

(vl-cmdf "_.DDEDIT" txtTemp)

(setq NewValue (GetDxf 1 (entget (entlast))))

(TS:Change_ATT ObjBLK ObjATT)

(entdel txttemp)

(if (vlax-property-available-p ObjATT 'Visible)

(vlax-put ObjATT 'Visible 1)

)

)

(while (setq SelATT (entsel "\Chon Text trong Block ATT can Edit:"))

(TS:STK SelATT)

)

(princ)

)

[quocmanh04tt 635]

Không biết bạn đã xử lý được chưa?

* Theo mình kiểm tra thì thấy có một số biến bạn khử sớm quá (Xác định biến cục bộ và biến toàn cục), giải quyết vấn đề này là OK.

[Tr.CongSon 42]

Không biết bạn đã xử lý được chưa?

* Theo mình kiểm tra thì thấy có một số biến bạn khử sớm quá (Xác định biến cục bộ và biến toàn cục), giải quyết vấn đề này là OK.

 

Hôm qua cũng nghi nghi cái biến ,Giờ em sửa được rồi a .Bỏ 2 thằng này (objatt objblk ) ở hàm( TS:STK)  là được ạ :)

Giờ đang cải tiến thêm để xử lý một số điều kiện cho Text chon nữa ^^

Anh Check giúp em còn trường hợp nào bị lỗi nữa không ạ.

Em cảm ơn..!

[Tr.CongSon 42]

Anh chị cho em hỏi cách Add  1 text vào Block Attribute đã có với ạ,

Hoặc có thể code cho em 1 đoạn tham khảo cũng được

Em cảm ơn,

[duy782006 1.551]

Mình viết tkt có đoạn như sau

Mục đích nhập vào 1 số hoặc biểu thức và thu về kết quả nhưng vì lisp bị giới hạn gì đó mà số lớn hơn giới hạn nào đó thì nó sẽ ra kết quả sai. Bác nào có cách khắc phục dể hiểu thì hướng dẩn mình phát. Cám ơn!

 

(defun c:nbt ()
(command "cal" "1+2")
(setq giatrim (getstring "Nhap bieu thuc: "))
(setq giatrim (rtos (C:cal giatrim) 2 0))
(princ giatrim))

[Tue_NV 3.912]

 

Mình viết tkt có đoạn như sau

Mục đích nhập vào 1 số hoặc biểu thức và thu về kết quả nhưng vì lisp bị giới hạn gì đó mà số lớn hơn giới hạn nào đó thì nó sẽ ra kết quả sai. Bác nào có cách khắc phục dể hiểu thì hướng dẩn mình phát. Cám ơn!

 

(defun c:nbt ()
(command "cal" "1+2")
(setq giatrim (getstring "Nhap bieu thuc: "))
(setq giatrim (rtos (C:cal giatrim) 2 0))
(princ giatrim))

 

 

Anh tham khảo nhé!

http://www.cadviet.com/forum/topic/14210-hoi-ve-lisp-thuat-toan-y-tuong-coding/page-80

[pphung183 428]

 

Mình viết tkt có đoạn như sau

Mục đích nhập vào 1 số hoặc biểu thức và thu về kết quả nhưng vì lisp bị giới hạn gì đó mà số lớn hơn giới hạn nào đó thì nó sẽ ra kết quả sai. Bác nào có cách khắc phục dể hiểu thì hướng dẩn mình phát. Cám ơn!

 

(defun c:nbt ()
(command "cal" "1+2")
(setq giatrim (getstring "Nhap bieu thuc: "))
(setq giatrim (rtos (C:cal giatrim) 2 0))
(princ giatrim))

 

Do Cal giới hạn số nguyên nên Lisp bạn nhập số nguyên đủ lớn là kết quả sẽ sai. Do đó nếu nhập 1000000 + 1000000 thì phải nhập 1000000.+1000000. .

Bạn hãy tận dụng tính chất của Filed sẽ giải quyết vấn đề trên :). Thử Lisp này xem sao :

(defun C:CalE (/ ms str obj) (vl-load-com)
(setq ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq str (getstring "\nNhap bieu thuc CAL dang :  1+2*2+6/2-3 \n"))
(setq obj (vla-AddText ms "xx" (vlax-3d-point '(0 0 0)) 2))
(vla-put-TextString obj (strcat "%<\\AcExpr (" str ")>%"))
(princ (strcat str "=" (vla-get-TextString obj)))
(vla-delete obj) (textscr) (princ))

[duy782006 1.551]

He he cách củ chuối nhất là nối thêm cái chuổi cần tính với "+0." giải quyết xong trong mức độ duy cần. Cám ơn hai bạn.

(defun c:nbt ()
(command "cal" "1+2")
(setq giatrim (getstring "Nhap bieu thuc: "))
(setq giatrim (strcat giatrim "+0."))
(setq giatrim (rtos (C:cal giatrim) 2 0))
(princ giatrim))

[ndtnv 481]

 

Do Cal giới hạn số nguyên nên Lisp bạn nhập số nguyên đủ lớn là kết quả sẽ sai. Do đó nếu nhập 1000000 + 1000000 thì phải nhập 1000000.+1000000. .

Bạn hãy tận dụng tính chất của Filed sẽ giải quyết vấn đề trên :). Thử Lisp này xem sao :

(defun C:CalE (/ ms str obj) (vl-load-com)
(setq ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq str (getstring "\nNhap bieu thuc CAL dang :  1+2*2+6/2-3 \n"))
(setq obj (vla-AddText ms "xx" (vlax-3d-point '(0 0 0)) 2))
(vla-put-TextString obj (strcat "%<\\AcExpr (" str ")>%"))
(princ (strcat str "=" (vla-get-TextString obj)))
(vla-delete obj) (textscr) (princ))

 

 

 

He he cách củ chuối nhất là nối thêm cái chuổi cần tính với "+0." giải quyết xong trong mức độ duy cần. Cám ơn hai bạn.

(defun c:nbt ()
(command "cal" "1+2")
(setq giatrim (getstring "Nhap bieu thuc: "))
(setq giatrim (strcat giatrim "+0."))
(setq giatrim (rtos (C:cal giatrim) 2 0))
(princ giatrim))

Giới hạn của số nguyên là từ -2,147,483,648 => 2,147,483,647

Vì vậy nếu kết quả trung gian là số nguyên nằm ngoài giới hạn trên kết quả sẽ sai.

VD: Cách của cả 2 bạn đều không tính được 1000000*10000

Cách của Tue_NV trong link trên tuy giải quyết các trường hợp này nhưng lúc dùng có nhiều vấn đề đã bàn trong topic đó.

Tốt nhất là trong biểu thức nhập, thay vì số nguyên thì nhập thêm dấu chấm động ở các vị trí thích hợp

[duy782006 1.551]

Hẹ hẹ thế mới nói là mức độ duy cần. Dùng trong thống kê thép thôi chắc ko mấy khi đến số lớn như thế. Cách hoàn mỹ thì hóng thôi.

[pphung183 428]

Hẹ hẹ thế mới nói là mức độ duy cần. Dùng trong thống kê thép thôi chắc ko mấy khi đến số lớn như thế. Cách hoàn mỹ thì hóng thôi.

Không nên cầu toàn bạn ah :) , thêm dấu chấm động ở các vị trí thích hợp khi cần tính số lớn là đươc. Giáo sư tiến sĩ ở VN mà toàn làm quan không thì mãi mãi dân tộc này cũng vẫn là dân trí thấp :D

[duy782006 1.551]

Thì thế. Thật ra mình cũng nghỉ ra cách là tách các chuổi ngăn cách bởi + - * / rồi kiểm tra các chuổi con có dấu chấm chưa nếu chưa thì thêm dấu chấm vào nhưng lười nên thế là ok rồi.

[VoHoan 6]

Nhờ cao thủ viết giúp mình thuật toán cho yêu cầu sau:

Có 1 đường Pline gồm n đỉnh, giờ mình muốn chuyến tọa độ của các đỉnh của đường pline về n tọa độ bất kỳ (đã biết). Chúy ý vẫn giữ nguên đối tượng là đường pline, thao tác lisp chỉ là cập nhật lại tọa độ dỉnh đường pline theo tọa độ mới chứ không phải tạo ra đường pline mới từ n tọa độ (đa biết) đó!

[Tr.CongSon 42]

Nhờ cao thủ viết giúp mình thuật toán cho yêu cầu sau:

Có 1 đường Pline gồm n đỉnh, giờ mình muốn chuyến tọa độ của các đỉnh của đường pline về n tọa độ bất kỳ (đã biết). Chúy ý vẫn giữ nguên đối tượng là đường pline, thao tác lisp chỉ là cập nhật lại tọa độ dỉnh đường pline theo tọa độ mới chứ không phải tạo ra đường pline mới từ n tọa độ (đa biết) đó!

 

Em cũng muốn thử sức mình Code xem thế nào nhưng hình dung mãi không ra ^^

 

Tốt nhất anh nên đính kèm file minh họa ,đường pline nó ra sao ,kín hay hở,rồi tọa độ n đỉnh của anh lấy từ đâu(từ file txt hay excel hay cad).

Ngoài ra,có sắp xếp theo thứ tự chi ko? .Chứ em sợ lấy "râu ông nọ cắm cằm bà kia " lắm ^^

 

Thân ái!

[VoHoan 6]

Mình đưa bản vẽ mẫu lên bạn xem giúp nhé.

https://drive.google.com/file/d/0B1YgZYg5Tac3bUYxSWV1Ym9qNlk/view?usp=sharing

[Tr.CongSon 42]

Mình đưa bản vẽ mẫu lên bạn xem giúp nhé.

 

 

Em đã xem và thấy bế tắc toàn tập ^^

Các tọa độ "đã biết" của anh ở đây là biên dạng (dưới) của Block -> mà Lấy tọa độ cái này ngoài tầm với của e ^^

Thôi thì a chờ các cao thủ khác ra tay giúp vậy  .

Cái này em bó tay ^^

 

P/s: Em nghĩ a "kéo" nút xanh xanh của Pline đó về vị trí cần thì nhanh hơn là dùng lisp nhiều ^^ Vì khi dùng lisp ,kiểu chi rồi anh cũng phải pick từng điểm để chỉ định cho nó thôi ^^

[Tue_NV 3.912]

Em đã xem và thấy bế tắc toàn tập ^^

Các tọa độ "đã biết" của anh ở đây là biên dạng (dưới) của Block -> mà Lấy tọa độ cái này ngoài tầm với của e ^^

Thôi thì a chờ các cao thủ khác ra tay giúp vậy  .

Cái này em bó tay ^^

 

P/s: Em nghĩ a "kéo" nút xanh xanh của Pline đó về vị trí cần thì nhanh hơn là dùng lisp nhiều ^^ Vì khi dùng lisp ,kiểu chi rồi anh cũng phải pick từng điểm để chỉ định cho nó thôi ^^

 

1./ Tất nhiên dùng Lisp sẽ nhanh hơn rất nhiều rồi ^_^

2./ Nếu Đường màu xanh Pline luôn vẽ đúng theo số đỉnh (9 đỉnh) và rãnh luôn vẽ đúng với Block Ranh BT như quy luật trong bản vẽ thì hoàn toàn có thể dùng Lisp để tự động chỉ định đỉnh cho nó

[VoHoan 6]

Vì nhiều trắc ngang voi nhiều km đường nên mới dùng lisp chứ. Việc lấy toạ độ đế cập nhật cho đường pline thi không khó. Có cao thủ nào xem chỉ giúp mình sớm với!!!

[VoHoan 6]

Tue có thể viết cho mình thuật toán cập nhật toạ độ đường pline theo toạ độ mới được không. Mình cũng biết đôi chút về lisp nên các bước tiếp theo mình sẽ thử làm ntn.

[Tue_NV 3.912]

Tue có thể viết cho mình thuật toán cập nhật toạ độ đường pline theo toạ độ mới được không. Mình cũng biết đôi chút về lisp nên các bước tiếp theo mình sẽ thử làm ntn.

 

Đơn giản là subst + entmod ename thôi bạn ạ!

[VoHoan 6]

Bạn có thể viết cụ thể ra với trường hợp tổng quát giúp mình được không. Hoặc cho mình một ví dụ cụ thể để tham khảo với.

[Tue_NV 3.912]

Bạn có thể viết cụ thể ra với trường hợp tổng quát giúp mình được không. Hoặc cho mình một ví dụ cụ thể để tham khảo với.

 

Ví dụ: 

Update các đỉnh Pline (dịch đi 1 khoảng) X=1.0 Y=1.0

(defun c:uppl(e ent lst-dinh-res lst-dinh-des)
  (setq e (car(entsel "\nChon PLINE :")))
  (setq ent (entget e))
  (setq lst-dinh-res (vl-remove-if-not '(lambda(x) (= (car x) 10)) ent))
  (setq lst-dinh-des (mapcar '(lambda(x) (list (car x) (+ (cadr x) 1.0) (+ (caddr x) 1.0) 0.0)) lst-dinh-res))
  (mapcar '(lambda(x y) (setq ent (subst x y ent)))  lst-dinh-des lst-dinh-res)
  (entmod ent)
)