Đến nội dung


Hình ảnh
- - - - -

Hỏi về hàm trong lisp


  • Please log in to reply
30 replies to this topic

#1 khuatduyluong

khuatduyluong

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 08 January 2014 - 07:53 AM

Sau một thời gian tham gia diễn đàn, thấy rằng diễn đàn của mình nhiều cao thu và nhiệt tình giúp đỡ. Cộng với thấy được tác dụng lớn của Autolisp. Nên mình quyết định nghiên cứu lại lisp thực sự. Mong được sự chỉ giáo của các cao thủ.

Việc đầu tiên là mình muốn hỏi về thuật toán hay Hàm trong lisp: Nếu muốn thêm một stacked text thì phải sử dụng hàm gì, hoặc đơn giản như muốn thêm một text vào một đối tượng chữa text có sẵn thì thuật toán là gì? và phải sử dụng hàm gì? Ví dụ với một đường kích thước có sẵn, giờ mình muốn thêm ký tự vào bằng hàm và thuật toán như thế nào trong lisp? Và các đối tượng chứa text khác cũng tương tự.

Bởi vì khi mình muốn sử dụng lệnh edit để chỉnh sửa text thì thấy không có hiệu quả. Chương trình luôn báo lỗi.


  • 0

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 08 January 2014 - 07:59 AM

Để trả lời câu hỏi "đơn giản" của bạn, phải mất một ngày!

Để hiểu bản chất cuả 1 ngày trả lời, phải mất 1 tháng!

Để biến bản chất đã hiểu thành lisp, phải mất 1 năm!


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 khuatduyluong

khuatduyluong

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 08 January 2014 - 08:04 AM

Để trả lời câu hỏi "đơn giản" của bạn, phải mất một ngày!

Để hiểu bản chất cuả 1 ngày trả lời, phải mất 1 tháng!

Để biến bản chất đã hiểu thành lisp, phải mất 1 năm!

 

 

Không mất nhiều như vậy đâu. Bởi vì mình đã từng đọc và tìm hiểu về lisp. Cũng từng lập trình ra giao diện hộp thoại cho một lệnh định nghĩa mới. Mình chỉ muốn hỏi là thông qua hàm gì để có thể chèn thêm text hoặc stacked text vào đối tượng như dimesion. Thuật toán thì mình tự nghĩ vậy.


  • 0

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 08 January 2014 - 08:15 AM

Có phải bạn muốn thêm 1 Prefix hoặc Suffix vào 1 text có sẵn trên bản vẽ? Nếu đúng vậy thì câu hỏi của bạn khó hiểu quá.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 08 January 2014 - 08:29 AM

Không mất nhiều như vậy đâu. Bởi vì mình đã từng đọc và tìm hiểu về lisp. Cũng từng lập trình ra giao diện hộp thoại cho một lệnh định nghĩa mới. Mình chỉ muốn hỏi là thông qua hàm gì để có thể chèn thêm text hoặc stacked text vào đối tượng như dimesion. Thuật toán thì mình tự nghĩ vậy.

 

Sử dụng hàm command của Lisp và lệnh Dimedit mà Tue_NV đã từng gợi ý cho bạn


  • 1

#6 khuatduyluong

khuatduyluong

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 08 January 2014 - 09:30 AM

Sử dụng hàm command của Lisp và lệnh Dimedit mà Tue_NV đã từng gợi ý cho bạn

 

 

Ok. Thanks. Mình sẽ kiểm tra hàm này.


  • 0

#7 khuatduyluong

khuatduyluong

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 08 January 2014 - 09:31 AM

Có phải bạn muốn thêm 1 Prefix hoặc Suffix vào 1 text có sẵn trên bản vẽ? Nếu đúng vậy thì câu hỏi của bạn khó hiểu quá.

 

 

Đúng là em muốn như vậy nhưng với một cách lam của lisp. Tức là sử dụng hàm nào để làm được điều đó. Chứ không phải lênh, tất nhiên.


  • 0

#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 08 January 2014 - 09:56 AM

Tôi không biết có hàm nào có thể làm được điều đó, nhưng tôi có viết 1 lisp cho Group CadMagic, chưa post trên CV. Nếu bạn cần thì tôi tặng.


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#9 khuatduyluong

khuatduyluong

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 08 January 2014 - 10:16 AM

Tôi không biết có hàm nào có thể làm được điều đó, nhưng tôi có viết 1 lisp cho Group CadMagic, chưa post trên CV. Nếu bạn cần thì tôi tặng.

 

 

Nếu được bác tặng thì hay quá. Để em có thể nghiên cứu.


  • 0

#10 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 08 January 2014 - 10:24 AM

Lisp thêm tiền tố và/hoặc hậu tố cho DIMENSION, TEXT, MTEXT, ATTDEF.

;----- Add/Change Prefix and/or Suffix for DIMENSION, TEXT, MTEXT, ATTDEF. De tim hieu code >> nen mo trong Notepad++.
;----- Doan Van Ha - CadMagic - Ver.1: 15/9/2013
(vl-load-com)
(defun C:APS ( / dial flag lstobj lstkey lstvar fn Add_Prefix_Suffix SelectObj Ss->Lst Old_APS New_APS HA:SetVal Make_File_Dcl)
;----- Sub Functions
 (defun Add_Prefix_Suffix (lst pre suf add) ;Add Prefix vµ/hoÆc Suffix cho lstobj.
  (command "undo" "be")
  (if (and lst pre suf)
   (mapcar
   '(lambda (obj / typ txt pre1 suf1)
     (setq typ (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))))
     (cond
      ((wcmatch typ "MTEXT,TEXT") (vla-put-TextString obj (strcat pre (vla-get-TextString obj) suf))) ;MultiLeader ???
      ((wcmatch typ "ATTDEF") (vla-put-TagString obj (strcat pre (vla-get-TagString obj) suf)))
      ((wcmatch typ "DIMENSION")
  (setq txt (cdr (assoc 1 (entget (vlax-vla-object->ename obj)))) pre1 (vla-get-TextPrefix obj) suf1 (vla-get-TextSuffix obj))
       (cond
        ((and (= txt "") (= add "0")) ; Nguyen thuy hoac da add pre/suf: Change
(vla-put-TextPrefix obj pre) (vla-put-TextSuffix obj suf))
((and (= txt "") (= add "1")) ; Nguyen thuy hoac da add pre/suf: Add
(vla-put-TextPrefix obj (strcat pre pre1)) (vla-put-TextSuffix obj (strcat suf1 suf)))
     (T ; Override: Add (not Change)
(vla-put-TextOverride obj (strcat pre txt suf))))))
     (vlax-release-object obj))
    lst))
  (command "undo" "e"))
 (defun SelectObj (lstvar lstkey / txt lst) ;Chän ®èi t­îng.
  (setq txt (apply 'strcat (mapcar '(lambda(var key) (if (= var "1") (strcat key ",") "")) (mapcar 'eval lstvar) lstkey)))
  (setq lst (Ss->Lst (ssget (list (cons 0 txt))) T)))
 (defun Ss->Lst (ss flag / lst) ;Convert selection set to list vla-object
  (and ss (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (if flag (setq lst (mapcar 'vlax-ename->vla-object lst))))
  lst)
 (defun Old_APS() ;®Æt chƠ ®é nh­ c̣.
  (setq text_old text mtext_old mtext attdef_old attdef dimension_old dimension pre_old pre suf_old suf add_old add change_old change))
 (defun New_APS() ;®Æt chƠ ®é míi nh­ c̣".
  (setq text text_old mtext mtext_old attdef attdef_old dimension dimension_old pre pre_old suf suf_old add add_old change change_ols))
 (defun HA:SetVal (lstkey lstvar lstval) ;Set value_default or set value_old for var + Set_tile for key. EX: (HA:SetVal '("key1" "key2" "key3") '(var1 var2 var3) '("0" "1" "a"))
  (mapcar '(lambda (var val) (if (not (eval var)) (set var val))) lstvar lstval)
  (mapcar '(lambda (key val) (set_tile key (set (read key) val))) lstkey (mapcar 'eval lstvar)))
 (defun Make_File_Dcl ( / fn ow dial) 
  (setq fn (vl-filename-mktemp "APS" nil ".dcl"))
  (setq ow (open fn "w"))
  (mapcar
  '(lambda (x) (write-line x ow))
   (list
"APS : dialog { label = \"CadMagic - Add prefix and suffix for objects\";"
" : boxed_column { label = \"Set variable\";"
"    : row {"
"      : boxed_column { label = \"Dimension\";"
"        : toggle { label = \"Dimension\"; key = \"dimension\"; }"
"        : radio_row {"
"          : radio_button { label = \"Add\";  key = \"add\"; }"
"          : radio_button { label = \"Change\";  key = \"change\"; }"
"        }"
"      }"
"      : boxed_row { label = \"Text/Mtext/Attdef\";"
"        : toggle { label = \"Text\"; key = \"text\"; }"
"        : toggle { label = \"Mtext\"; key = \"mtext\"; }"
"        : toggle { label = \"Attdef\"; key = \"attdef\"; }"
"      }"
"    }"
"    : column {"
"      : edit_box { label = \"Prefix:\"; key = \"pre\"; edit_width = 45; }"
"      : edit_box { label = \"Suffix:\"; key = \"suf\"; edit_width = 45; }"
"    }"
" : button { label = \"Select objects\"; key = \"chon\"; fixed_width = true; alignment = centered; }"
"  }"
"  ok_cancel;"
"}"))
  (close ow)
  fn)
;----- Main Function.
 (setq dial (load_dialog (setq fn (Make_File_Dcl))) flag 3)
 (while (> flag 1)
  (if (not (new_dialog "APS" dial)) (exit))
  (Old_APS)
  (HA:SetVal (setq lstkey '("text" "mtext" "attdef" "dimension" "pre" "suf" "add" "change"))
            (setq lstvar '(text mtext attdef dimension pre suf add change)) '("0" "0" "0" "0" "Prefix" "Suffix" "1" "0"))
  (action_tile "text" "(setq text $value)")
  (action_tile "mtext" "(setq mtext $value)")
  (action_tile "attdef" "(setq attdef $value)")
  (action_tile "dimension" "(setq dimension $value)")
  (action_tile "pre" "(setq pre $value)")
  (action_tile "suf" "(setq suf $value)")
  (action_tile "add" "(setq add $value change \"0\")")
  (action_tile "change" "(setq change $value add \"0\")")
  (action_tile "Cancel" "(done_dialog 0)")
  (action_tile "Accept" "(done_dialog 1)")
  (action_tile "chon" "(done_dialog 2)")
  (setq flag (start_dialog))
  (cond ((= 0 flag) (New_APS))
        ((= 2 flag) (setq lstobj (SelectObj lstvar lstkey)))
        ((= 1 flag) (Add_Prefix_Suffix lstobj pre suf add))))
 (unload_dialog dial) (vl-file-delete fn) (princ))
;--------------------------------------------------------------------------------------------------------------------------------------
 


  • 3

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#11 khuatduyluong

khuatduyluong

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 08 January 2014 - 10:30 AM

Lisp thêm tiền tố và/hoặc hậu tố cho DIMENSION, TEXT, MTEXT, ATTDEF.

;----- Add/Change Prefix and/or Suffix for DIMENSION, TEXT, MTEXT, ATTDEF. De tim hieu code >> nen mo trong Notepad++.
;----- Doan Van Ha - CadMagic - Ver.1: 15/9/2013
(vl-load-com)
(defun C:APS ( / dial flag lstobj lstkey lstvar fn Add_Prefix_Suffix SelectObj Ss->Lst Old_APS New_APS HA:SetVal Make_File_Dcl)
;----- Sub Functions
 (defun Add_Prefix_Suffix (lst pre suf add) ;Add Prefix vµ/hoÆc Suffix cho lstobj.
  (command "undo" "be")
  (if (and lst pre suf)
   (mapcar
   '(lambda (obj / typ txt pre1 suf1)
     (setq typ (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))))
     (cond
      ((wcmatch typ "MTEXT,TEXT") (vla-put-TextString obj (strcat pre (vla-get-TextString obj) suf))) ;MultiLeader ???
      ((wcmatch typ "ATTDEF") (vla-put-TagString obj (strcat pre (vla-get-TagString obj) suf)))
      ((wcmatch typ "DIMENSION")
  (setq txt (cdr (assoc 1 (entget (vlax-vla-object->ename obj)))) pre1 (vla-get-TextPrefix obj) suf1 (vla-get-TextSuffix obj))
       (cond
        ((and (= txt "") (= add "0")) ; Nguyen thuy hoac da add pre/suf: Change
(vla-put-TextPrefix obj pre) (vla-put-TextSuffix obj suf))
((and (= txt "") (= add "1")) ; Nguyen thuy hoac da add pre/suf: Add
(vla-put-TextPrefix obj (strcat pre pre1)) (vla-put-TextSuffix obj (strcat suf1 suf)))
     (T ; Override: Add (not Change)
(vla-put-TextOverride obj (strcat pre txt suf))))))
     (vlax-release-object obj))
    lst))
  (command "undo" "e"))
 (defun SelectObj (lstvar lstkey / txt lst) ;Chän ®èi t­îng.
  (setq txt (apply 'strcat (mapcar '(lambda(var key) (if (= var "1") (strcat key ",") "")) (mapcar 'eval lstvar) lstkey)))
  (setq lst (Ss->Lst (ssget (list (cons 0 txt))) T)))
 (defun Ss->Lst (ss flag / lst) ;Convert selection set to list vla-object
  (and ss (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (if flag (setq lst (mapcar 'vlax-ename->vla-object lst))))
  lst)
 (defun Old_APS() ;®Æt chƠ ®é nh­ c̣.
  (setq text_old text mtext_old mtext attdef_old attdef dimension_old dimension pre_old pre suf_old suf add_old add change_old change))
 (defun New_APS() ;®Æt chƠ ®é míi nh­ c̣".
  (setq text text_old mtext mtext_old attdef attdef_old dimension dimension_old pre pre_old suf suf_old add add_old change change_ols))
 (defun HA:SetVal (lstkey lstvar lstval) ;Set value_default or set value_old for var + Set_tile for key. EX: (HA:SetVal '("key1" "key2" "key3") '(var1 var2 var3) '("0" "1" "a"))
  (mapcar '(lambda (var val) (if (not (eval var)) (set var val))) lstvar lstval)
  (mapcar '(lambda (key val) (set_tile key (set (read key) val))) lstkey (mapcar 'eval lstvar)))
 (defun Make_File_Dcl ( / fn ow dial) 
  (setq fn (vl-filename-mktemp "APS" nil ".dcl"))
  (setq ow (open fn "w"))
  (mapcar
  '(lambda (x) (write-line x ow))
   (list
"APS : dialog { label = \"CadMagic - Add prefix and suffix for objects\";"
" : boxed_column { label = \"Set variable\";"
"    : row {"
"      : boxed_column { label = \"Dimension\";"
"        : toggle { label = \"Dimension\"; key = \"dimension\"; }"
"        : radio_row {"
"          : radio_button { label = \"Add\";  key = \"add\"; }"
"          : radio_button { label = \"Change\";  key = \"change\"; }"
"        }"
"      }"
"      : boxed_row { label = \"Text/Mtext/Attdef\";"
"        : toggle { label = \"Text\"; key = \"text\"; }"
"        : toggle { label = \"Mtext\"; key = \"mtext\"; }"
"        : toggle { label = \"Attdef\"; key = \"attdef\"; }"
"      }"
"    }"
"    : column {"
"      : edit_box { label = \"Prefix:\"; key = \"pre\"; edit_width = 45; }"
"      : edit_box { label = \"Suffix:\"; key = \"suf\"; edit_width = 45; }"
"    }"
" : button { label = \"Select objects\"; key = \"chon\"; fixed_width = true; alignment = centered; }"
"  }"
"  ok_cancel;"
"}"))
  (close ow)
  fn)
;----- Main Function.
 (setq dial (load_dialog (setq fn (Make_File_Dcl))) flag 3)
 (while (> flag 1)
  (if (not (new_dialog "APS" dial)) (exit))
  (Old_APS)
  (HA:SetVal (setq lstkey '("text" "mtext" "attdef" "dimension" "pre" "suf" "add" "change"))
            (setq lstvar '(text mtext attdef dimension pre suf add change)) '("0" "0" "0" "0" "Prefix" "Suffix" "1" "0"))
  (action_tile "text" "(setq text $value)")
  (action_tile "mtext" "(setq mtext $value)")
  (action_tile "attdef" "(setq attdef $value)")
  (action_tile "dimension" "(setq dimension $value)")
  (action_tile "pre" "(setq pre $value)")
  (action_tile "suf" "(setq suf $value)")
  (action_tile "add" "(setq add $value change \"0\")")
  (action_tile "change" "(setq change $value add \"0\")")
  (action_tile "Cancel" "(done_dialog 0)")
  (action_tile "Accept" "(done_dialog 1)")
  (action_tile "chon" "(done_dialog 2)")
  (setq flag (start_dialog))
  (cond ((= 0 flag) (New_APS))
        ((= 2 flag) (setq lstobj (SelectObj lstvar lstkey)))
        ((= 1 flag) (Add_Prefix_Suffix lstobj pre suf add))))
 (unload_dialog dial) (vl-file-delete fn) (princ))
;--------------------------------------------------------------------------------------------------------------------------------------
 

 

 

Thank bác nhiều. E sẽ nghiên cứu đã rùi có gì hỏi bác sau.


  • 0

#12 khuatduyluong

khuatduyluong

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 10 January 2014 - 09:47 AM

Lisp thêm tiền tố và/hoặc hậu tố cho DIMENSION, TEXT, MTEXT, ATTDEF.

;----- Add/Change Prefix and/or Suffix for DIMENSION, TEXT, MTEXT, ATTDEF. De tim hieu code >> nen mo trong Notepad++.
;----- Doan Van Ha - CadMagic - Ver.1: 15/9/2013
(vl-load-com)
(defun C:APS ( / dial flag lstobj lstkey lstvar fn Add_Prefix_Suffix SelectObj Ss->Lst Old_APS New_APS HA:SetVal Make_File_Dcl)
;----- Sub Functions
 (defun Add_Prefix_Suffix (lst pre suf add) ;Add Prefix vµ/hoÆc Suffix cho lstobj.
  (command "undo" "be")
  (if (and lst pre suf)
   (mapcar
   '(lambda (obj / typ txt pre1 suf1)
     (setq typ (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))))
     (cond
      ((wcmatch typ "MTEXT,TEXT") (vla-put-TextString obj (strcat pre (vla-get-TextString obj) suf))) ;MultiLeader ???
      ((wcmatch typ "ATTDEF") (vla-put-TagString obj (strcat pre (vla-get-TagString obj) suf)))
      ((wcmatch typ "DIMENSION")
  (setq txt (cdr (assoc 1 (entget (vlax-vla-object->ename obj)))) pre1 (vla-get-TextPrefix obj) suf1 (vla-get-TextSuffix obj))
       (cond
        ((and (= txt "") (= add "0")) ; Nguyen thuy hoac da add pre/suf: Change
(vla-put-TextPrefix obj pre) (vla-put-TextSuffix obj suf))
((and (= txt "") (= add "1")) ; Nguyen thuy hoac da add pre/suf: Add
(vla-put-TextPrefix obj (strcat pre pre1)) (vla-put-TextSuffix obj (strcat suf1 suf)))
     (T ; Override: Add (not Change)
(vla-put-TextOverride obj (strcat pre txt suf))))))
     (vlax-release-object obj))
    lst))
  (command "undo" "e"))
 (defun SelectObj (lstvar lstkey / txt lst) ;Chän ®èi t­îng.
  (setq txt (apply 'strcat (mapcar '(lambda(var key) (if (= var "1") (strcat key ",") "")) (mapcar 'eval lstvar) lstkey)))
  (setq lst (Ss->Lst (ssget (list (cons 0 txt))) T)))
 (defun Ss->Lst (ss flag / lst) ;Convert selection set to list vla-object
  (and ss (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (if flag (setq lst (mapcar 'vlax-ename->vla-object lst))))
  lst)
 (defun Old_APS() ;®Æt chƠ ®é nh­ c̣.
  (setq text_old text mtext_old mtext attdef_old attdef dimension_old dimension pre_old pre suf_old suf add_old add change_old change))
 (defun New_APS() ;®Æt chƠ ®é míi nh­ c̣".
  (setq text text_old mtext mtext_old attdef attdef_old dimension dimension_old pre pre_old suf suf_old add add_old change change_ols))
 (defun HA:SetVal (lstkey lstvar lstval) ;Set value_default or set value_old for var + Set_tile for key. EX: (HA:SetVal '("key1" "key2" "key3") '(var1 var2 var3) '("0" "1" "a"))
  (mapcar '(lambda (var val) (if (not (eval var)) (set var val))) lstvar lstval)
  (mapcar '(lambda (key val) (set_tile key (set (read key) val))) lstkey (mapcar 'eval lstvar)))
 (defun Make_File_Dcl ( / fn ow dial) 
  (setq fn (vl-filename-mktemp "APS" nil ".dcl"))
  (setq ow (open fn "w"))
  (mapcar
  '(lambda (x) (write-line x ow))
   (list
"APS : dialog { label = \"CadMagic - Add prefix and suffix for objects\";"
" : boxed_column { label = \"Set variable\";"
"    : row {"
"      : boxed_column { label = \"Dimension\";"
"        : toggle { label = \"Dimension\"; key = \"dimension\"; }"
"        : radio_row {"
"          : radio_button { label = \"Add\";  key = \"add\"; }"
"          : radio_button { label = \"Change\";  key = \"change\"; }"
"        }"
"      }"
"      : boxed_row { label = \"Text/Mtext/Attdef\";"
"        : toggle { label = \"Text\"; key = \"text\"; }"
"        : toggle { label = \"Mtext\"; key = \"mtext\"; }"
"        : toggle { label = \"Attdef\"; key = \"attdef\"; }"
"      }"
"    }"
"    : column {"
"      : edit_box { label = \"Prefix:\"; key = \"pre\"; edit_width = 45; }"
"      : edit_box { label = \"Suffix:\"; key = \"suf\"; edit_width = 45; }"
"    }"
" : button { label = \"Select objects\"; key = \"chon\"; fixed_width = true; alignment = centered; }"
"  }"
"  ok_cancel;"
"}"))
  (close ow)
  fn)
;----- Main Function.
 (setq dial (load_dialog (setq fn (Make_File_Dcl))) flag 3)
 (while (> flag 1)
  (if (not (new_dialog "APS" dial)) (exit))
  (Old_APS)
  (HA:SetVal (setq lstkey '("text" "mtext" "attdef" "dimension" "pre" "suf" "add" "change"))
            (setq lstvar '(text mtext attdef dimension pre suf add change)) '("0" "0" "0" "0" "Prefix" "Suffix" "1" "0"))
  (action_tile "text" "(setq text $value)")
  (action_tile "mtext" "(setq mtext $value)")
  (action_tile "attdef" "(setq attdef $value)")
  (action_tile "dimension" "(setq dimension $value)")
  (action_tile "pre" "(setq pre $value)")
  (action_tile "suf" "(setq suf $value)")
  (action_tile "add" "(setq add $value change \"0\")")
  (action_tile "change" "(setq change $value add \"0\")")
  (action_tile "Cancel" "(done_dialog 0)")
  (action_tile "Accept" "(done_dialog 1)")
  (action_tile "chon" "(done_dialog 2)")
  (setq flag (start_dialog))
  (cond ((= 0 flag) (New_APS))
        ((= 2 flag) (setq lstobj (SelectObj lstvar lstkey)))
        ((= 1 flag) (Add_Prefix_Suffix lstobj pre suf add))))
 (unload_dialog dial) (vl-file-delete fn) (princ))
;--------------------------------------------------------------------------------------------------------------------------------------
 

 

Sau một thời gian nghiên cứu, em vẫn chưa hiểu hết được chương trình của bác. Ở đây bác sử dụng hộp thoại để giao tiếp. Em đang muốn thay đổi thành lệnh. Vì với các tùy chọn đơn gian em nghĩ sử dụng lênh thì tiện và nhanh hơn. Nhưng em vẫn chưa thể hiểu hết. Nếu có thời gian bác có thể tư vấn giúp?

Thanks bác nhiều.


  • 0

#13 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 10 January 2014 - 09:56 AM

Dialog tường minh như thế mà khó hiểu ư? Bạn chỉ dùng cho Text thì tick vào ô "Text" rồi nhập tiền tố và/hoặc hậu tố.

Ai nỡ lòng tháo động cơ để xe máy trở thành xe đạp ?


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#14 khuatduyluong

khuatduyluong

    biết vẽ rectang

  • Members
  • PipPip
  • 81 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 10 January 2014 - 10:20 AM

Dialog tường minh như thế mà khó hiểu ư? Bạn chỉ dùng cho Text thì tick vào ô "Text" rồi nhập tiền tố và/hoặc hậu tố.

Ai nỡ lòng tháo động cơ để xe máy trở thành xe đạp ?

 

 

Em đâu có ý đó. Sản phẩm của bác em rất trân trọng. Chỉ là với công việc của em em muốn nó là lệnh để khỏi thao tác trên dialog. Chứ dialog là tuyệt vời rồi. Em đâu giám chê gì.


  • 0

#15 minhphuong_humg

minhphuong_humg

    biết lệnh offset

  • Members
  • PipPipPip
  • 175 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 22 January 2014 - 11:37 AM

Lisp thêm tiền tố và/hoặc hậu tố cho DIMENSION, TEXT, MTEXT, ATTDEF.

;----- Add/Change Prefix and/or Suffix for DIMENSION, TEXT, MTEXT, ATTDEF. De tim hieu code >> nen mo trong Notepad++.
;----- Doan Van Ha - CadMagic - Ver.1: 15/9/2013
(vl-load-com)
(defun C:APS ( / dial flag lstobj lstkey lstvar fn Add_Prefix_Suffix SelectObj Ss->Lst Old_APS New_APS HA:SetVal Make_File_Dcl)
;----- Sub Functions
 (defun Add_Prefix_Suffix (lst pre suf add) ;Add Prefix vµ/hoÆc Suffix cho lstobj.
  (command "undo" "be")
  (if (and lst pre suf)
   (mapcar
   '(lambda (obj / typ txt pre1 suf1)
     (setq typ (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))))
     (cond
      ((wcmatch typ "MTEXT,TEXT") (vla-put-TextString obj (strcat pre (vla-get-TextString obj) suf))) ;MultiLeader ???
      ((wcmatch typ "ATTDEF") (vla-put-TagString obj (strcat pre (vla-get-TagString obj) suf)))
      ((wcmatch typ "DIMENSION")
  (setq txt (cdr (assoc 1 (entget (vlax-vla-object->ename obj)))) pre1 (vla-get-TextPrefix obj) suf1 (vla-get-TextSuffix obj))
       (cond
        ((and (= txt "") (= add "0")) ; Nguyen thuy hoac da add pre/suf: Change
(vla-put-TextPrefix obj pre) (vla-put-TextSuffix obj suf))
((and (= txt "") (= add "1")) ; Nguyen thuy hoac da add pre/suf: Add
(vla-put-TextPrefix obj (strcat pre pre1)) (vla-put-TextSuffix obj (strcat suf1 suf)))
     (T ; Override: Add (not Change)
(vla-put-TextOverride obj (strcat pre txt suf))))))
     (vlax-release-object obj))
    lst))
  (command "undo" "e"))
 (defun SelectObj (lstvar lstkey / txt lst) ;Chän ®èi t­îng.
  (setq txt (apply 'strcat (mapcar '(lambda(var key) (if (= var "1") (strcat key ",") "")) (mapcar 'eval lstvar) lstkey)))
  (setq lst (Ss->Lst (ssget (list (cons 0 txt))) T)))
 (defun Ss->Lst (ss flag / lst) ;Convert selection set to list vla-object
  (and ss (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (if flag (setq lst (mapcar 'vlax-ename->vla-object lst))))
  lst)
 (defun Old_APS() ;®Æt chƠ ®é nh­ c̣.
  (setq text_old text mtext_old mtext attdef_old attdef dimension_old dimension pre_old pre suf_old suf add_old add change_old change))
 (defun New_APS() ;®Æt chƠ ®é míi nh­ c̣".
  (setq text text_old mtext mtext_old attdef attdef_old dimension dimension_old pre pre_old suf suf_old add add_old change change_ols))
 (defun HA:SetVal (lstkey lstvar lstval) ;Set value_default or set value_old for var + Set_tile for key. EX: (HA:SetVal '("key1" "key2" "key3") '(var1 var2 var3) '("0" "1" "a"))
  (mapcar '(lambda (var val) (if (not (eval var)) (set var val))) lstvar lstval)
  (mapcar '(lambda (key val) (set_tile key (set (read key) val))) lstkey (mapcar 'eval lstvar)))
 (defun Make_File_Dcl ( / fn ow dial) 
  (setq fn (vl-filename-mktemp "APS" nil ".dcl"))
  (setq ow (open fn "w"))
  (mapcar
  '(lambda (x) (write-line x ow))
   (list
"APS : dialog { label = \"CadMagic - Add prefix and suffix for objects\";"
" : boxed_column { label = \"Set variable\";"
"    : row {"
"      : boxed_column { label = \"Dimension\";"
"        : toggle { label = \"Dimension\"; key = \"dimension\"; }"
"        : radio_row {"
"          : radio_button { label = \"Add\";  key = \"add\"; }"
"          : radio_button { label = \"Change\";  key = \"change\"; }"
"        }"
"      }"
"      : boxed_row { label = \"Text/Mtext/Attdef\";"
"        : toggle { label = \"Text\"; key = \"text\"; }"
"        : toggle { label = \"Mtext\"; key = \"mtext\"; }"
"        : toggle { label = \"Attdef\"; key = \"attdef\"; }"
"      }"
"    }"
"    : column {"
"      : edit_box { label = \"Prefix:\"; key = \"pre\"; edit_width = 45; }"
"      : edit_box { label = \"Suffix:\"; key = \"suf\"; edit_width = 45; }"
"    }"
" : button { label = \"Select objects\"; key = \"chon\"; fixed_width = true; alignment = centered; }"
"  }"
"  ok_cancel;"
"}"))
  (close ow)
  fn)
;----- Main Function.
 (setq dial (load_dialog (setq fn (Make_File_Dcl))) flag 3)
 (while (> flag 1)
  (if (not (new_dialog "APS" dial)) (exit))
  (Old_APS)
  (HA:SetVal (setq lstkey '("text" "mtext" "attdef" "dimension" "pre" "suf" "add" "change"))
            (setq lstvar '(text mtext attdef dimension pre suf add change)) '("0" "0" "0" "0" "Prefix" "Suffix" "1" "0"))
  (action_tile "text" "(setq text $value)")
  (action_tile "mtext" "(setq mtext $value)")
  (action_tile "attdef" "(setq attdef $value)")
  (action_tile "dimension" "(setq dimension $value)")
  (action_tile "pre" "(setq pre $value)")
  (action_tile "suf" "(setq suf $value)")
  (action_tile "add" "(setq add $value change \"0\")")
  (action_tile "change" "(setq change $value add \"0\")")
  (action_tile "Cancel" "(done_dialog 0)")
  (action_tile "Accept" "(done_dialog 1)")
  (action_tile "chon" "(done_dialog 2)")
  (setq flag (start_dialog))
  (cond ((= 0 flag) (New_APS))
        ((= 2 flag) (setq lstobj (SelectObj lstvar lstkey)))
        ((= 1 flag) (Add_Prefix_Suffix lstobj pre suf add))))
 (unload_dialog dial) (vl-file-delete fn) (princ))
;--------------------------------------------------------------------------------------------------------------------------------------
 

Anh ơi, đây là lisp thêm tiền tố, hậu tố cho Dimension....Anh có thể thêm chức năng là remove tiền tố, hậu tố cho các trường hợp mà chúng (dimension..) đã có sẵn không ạ. Ví dụ: Em có các dimension với hậu tố là m (mét) em giờ muốn remove hết đi anh ạ.

Khi em load lisp trên thì xuất hiện lỗi này:

Command: ; error: syntax error

Mong anh giúp đỡ.

Trân trọng cảm ơn anh.


  • 0

#16 phamhuy1

phamhuy1

    biết vẽ rectang

  • Members
  • PipPip
  • 82 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 01 August 2014 - 12:36 PM

Anh Doan Van Ha ơi, cái lisp aps.lsp của a bị kẹt máy chỗ nào mà nó không chịu chạy :( ; đánh aps thì nó báo lỗi :   Command: ; error: syntax error

Help!!!!


  • 0

#17 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 01 August 2014 - 02:17 PM

Rất có thể chức năng down load của CadViet bị lỗi. Bạn copy lại xem, đừng down file.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#18 phamhuy1

phamhuy1

    biết vẽ rectang

  • Members
  • PipPip
  • 82 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 01 August 2014 - 02:39 PM

Em đã quét chọn hết code rồi Ctr+C-->Ctr+V mà nó vẫn báo lỗi Command: ; error: syntax error :wub: ... Nản thật! A có thể giúp e nén lại file .rar rồi post lại được không, e cần lisp này quá :(


  • 0

#19 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 01 August 2014 - 02:58 PM

Lỗi này là do ký tự xuống dòng trong Cadviet có thể là \r hoặc \n (chuẩn của Unix) , trong khi trong lisp là \r\n (chuẩn của Window)

Bạn hãy Ctr+V vào Word hoặc Excel, sau đó copy từ Word hoặc Excel vào lisp

Ký tự xuống dòng lúc này sẽ đổi thành \r\n


  • 0

#20 phamhuy1

phamhuy1

    biết vẽ rectang

  • Members
  • PipPip
  • 82 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 01 August 2014 - 03:09 PM

Đã thừ nhưng vẫn thất bại :wub: ... Thua!!!


  • 0