Chuyển đến nội dung
Diễn đàn CADViet
Jin Yong

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

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

Cái màu xanh:

Sau khi lấy được tính chất của Tag đó  => ẩn tag đó đi => entmake Text có một số tính chất của Tag (Textstring, Style, Heigth, Pos ...) => Edit text => Lấy giá trị mới của text này gán vào Tag và cho hiện lên=> Xóa text entmake.

Chỉ 1 bước: (defun c:test () (setq ent (entsel)) (setq a-ent (nentselp (cadr ent))))

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à 

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

@ Tr. Cong Son: Cấu tạo Block của mình bằng các Attribute (không sử dụng Field trong block thống kê thép tròn).

Hướng đi đúng theo quocmanh đã viết ^_^

  • 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

@ Tr. Cong Son: Cấu tạo Block của mình bằng các Attribute (không sử dụng Field trong block thống kê thép tròn).

Hướng đi đúng theo quocmanh đã viết ^_^

 

Thanks a Tuệ,

Anh chị cho em hỏi:em dùng code này để lấy list (Tagstring . Textstring) 

 

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

e2 (car (nentselp (cadr ent)))

obj (vlax-ename->vla-object ent)

lstATT (Getatt obj)

)

 

(defun GetAtt (obj)

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

(vlax-invoke obj 'GetAttributes)

)

)

 
Nhưng dùng thì có hồi được ,hồi báo lỗi như vậy:  ActiveX Server returned the error: unknown name: "GETATTRIBUTES"
Anh chị giải thích cho em biết và cách khắc phục như thế nào ko ạ?
Em cảm ơn
Chỉnh sửa theo Tr.CongSon

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

 

Thanks a Tuệ,

Anh chị cho em hỏi:em dùng code này để lấy list (Tagstring . Textstring) 

 

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

e2 (car (nentselp (cadr ent)))

obj (vlax-ename->vla-object ent)

lstATT (Getatt obj)

)

 

(defun GetAtt (obj)

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

(vlax-invoke obj 'GetAttributes)

)

)

 
Nhưng dùng thì có hồi được ,hồi báo lỗi như vậy:  ActiveX Server returned the error: unknown name: "GETATTRIBUTES"
Anh chị giải thích cho em biết và cách khắc phục như thế nào ko ạ?
Em cảm ơn

 

 

Bạn có thể kiểm tra ename đó có tồn tại dxf 66 khong? trước khi lấy  "GETATTRIBUTES"

  • 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

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

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

  • 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

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)

)

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

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.

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

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

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

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,

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

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

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

 

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

  • 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

 

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

  • 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

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

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

 

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

  • 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

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.

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

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

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

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.

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

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) đó!

  • Vote giảm 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

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!

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

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

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

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ó

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


×