Đến nội dung


Hình ảnh
- - - - -

Nhờ các anh chị giúp 1 đoạn LISP!


  • Please log in to reply
33 replies to this topic

#21 mrphuocvie

mrphuocvie

    biết vẽ ellipse

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

Đã gửi 01 August 2014 - 05:30 AM

Cảm ơn anh nguyentuyen6 nhưng điều em mong muốn chưa thực hiện được ah!

- Chọn đối tượng 1 (mục đích cuối cùng là để lấy nội dung text thôi)

- Chọn đối tượng 2 ( dán nội dung text vừa lấy được ở đối tượng 1) và sau đó XOÁ ĐỐI TƯỢNG 1 luôn ah!

Và các thao tác này được lặp lại cho đến khi người dùng muốn kết thúc lệnh thì bấm ESC hoặc Space.

 

Trong đoạn LISP em gửi lên forum thì có dòng lệnh (Command "ERASE" net), trong đó net là đối tượng 1, song nó lại không xoá được và kết thúc lệnh luôn. Còn anh nguyentuyen6 thì giúp em được cái làm nó chạy liên tục (chọn đối tượng 1[copy text], chọn đối tượng 2[paste text];..) chứ chưa xoá đối tượng 1 trong những vòng lặp đó ah.

Mong mọi người xem và sửa lại giúp em.

Xin cảm ơn!


  • -1

#22 mrphuocvie

mrphuocvie

    biết vẽ ellipse

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

Đã gửi 01 August 2014 - 08:12 AM

Anh nguyentuyen6 có thể giúp em thêm 1 dòng lệnh có chức năng XOÁ ĐỐI TƯỢNG 1 trong vòng lặp trên được không ah.

Em đã thử thêm vào nhưng nó không chạy ah.


  • 0

#23 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 01 August 2014 - 10:56 AM

Anh nguyentuyen6 có thể giúp em thêm 1 dòng lệnh có chức năng XOÁ ĐỐI TƯỢNG 1 trong vòng lặp trên được không ah.

Em đã thử thêm vào nhưng nó không chạy ah.

 

Bạn thử lại down lại lisp của mình nhé, mình xóa đối tượng 1 bằng dòng (entdel etname) rồi mà.


  • 0

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#24 mrphuocvie

mrphuocvie

    biết vẽ ellipse

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

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

Đoạn lisp trên chỉ xoá những đối tượng chứa text là Dtext hoặc Mtext, còn lại thì nó không xoá đối tượng 1 được.

Có các nào áp dụng cho cả text chứa trong dimension hoặc atribute không ah!


  • 0

#25 mrphuocvie

mrphuocvie

    biết vẽ ellipse

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

Đã gửi 03 August 2014 - 10:11 PM

Xin lỗi vì chưa tìm thấy...

Em muốn tạo một chủ đề mới nhưng đọc bài này chưa tìm thấy nút "GỬI BÀI MỚI" ở đâu hết. Mong mọi người chỉ giúp.

Và em có đoạn code này muốn tham khảo ý kiến mọi người:

(defun c:ART()
	(setvar "cmdecho" 0)
	(while
  		(vl-load-com)
  		(setq tx (vlax-ename->vla-object (car (entsel "\nSelect text to rotate counterclockwise 90 degrees!"))))
		(setq gbd (vla-get-Rotation tx))
		(if (or (= gbd 0) (= gbd (* 0.5 pi))(= gbd (* 1 pi))(= gbd (* 1.5 pi)))
	  		(vla-put-Rotation tx (+ gbd (* 0.5 pi)))
			(vla-put-Rotation tx 0)
		)
	)
	(setvar "cmdecho" 1)
	(princ "\Completed command!")
  	(princ)
)

Khi em chuyển nó từ .lsp thành .vlx thì nó autocad báo thế này: 

; Compilation aborted

; error: compiler found fatal error[s] "3302-ART.lsp"

; Compilation aborted
; error: compiler found fatal error[s] "3302-ART.lsp"
; Compilation aborted
 
; Compilation aborted
 
; Compilation aborted
 
; Compilation aborted
 
; Compilation aborted

  • 0

#26 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 04 August 2014 - 08:19 AM

File này không có lỗi gì khi compile, chắc khi kết hợp với file khác mới bị lỗi.


  • 0

#27 mrphuocvie

mrphuocvie

    biết vẽ ellipse

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

Đã gửi 07 August 2014 - 06:12 AM

Vậy xin mọi người chỉ em cách khắc phục lỗi trên!


  • 0

#28 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 07 August 2014 - 05:34 PM

Bạn thử để dòng (vl-load-com) trước dòng while


  • 0

#29 PrettyBoy_231988

PrettyBoy_231988

    biết zoom

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

Đã gửi 07 August 2014 - 09:46 PM

Hi ! Xin nhờ mọi người sửa giúp lisp copy thứ tứ tăng dần của tác giả interwar1283, trong lisp này chỉ cho copy đến 99 rồi lại về 0, nhờ mọi người sửa hộ lisp cho copy lên đến 1000. xin chân thành cảm ơn ! http://www.cadviet.c...hu-tu-tang-dan/

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...?showtopic=1398
;;;Edit by Interwar1283
;*********************************************************************
(defun ketthuc ()
(setvar "cmdecho" luuecho)
(setq *error* luu
luu nil
luuecho nil
);setq
(princ)
)
;*********************************************************************
(defun modau ()
(setq luu *error
luuecho (getvar "cmdecho")
*error (ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq kytu (substr text (strlen text))
ma (ascii kytu)
sokt (read kytu) 
lui 1
)
(if (numberp sokt)
(progn
(setq luusokt (1+ sokt))
(if (and (numberp sokt) 
(> (strlen text) 1)
   )
  (progn
(setq kytu (substr text (1- (strlen text)))
sokt (read kytu) 
)
(if (numberp sokt) 
(setq luusokt (1+ sokt)
lui 2
 
)
)
   );progn
)
(if (= luusokt> 100) (setq luusokt 0))
(setq kytu (rtos luusokt 2 0)
 
text (strcat (substr text 1 (- (strlen text) lui))  kytu)
)
);progn
(if   (or (= kytu "z")
(= kytu "Z")
)
(setq text (strcat text "0")
textxl "0"
)
(setq ma (1+ ma)
text (strcat (substr text 1 (1- (strlen text)))  (chr ma))
)
);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq doituong (entget  tendoituong)
kieu (cdr (assoc 0 doituong))
canle (cdr (assoc 72 doituong))
)
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
    )
(progn
(setq textxl (xulytext textxl)
text (cons 1 textxl)
vitri10 (cdr (assoc 10 doituong))
vitri10 (list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
vitri10 (cons 10 vitri10)
vitri11 (cdr (assoc 11 doituong))
vitri11 (list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
vitri11 (cons 11 vitri11)
dem 0
dsach nil
)
(foreach tam doituong
(cond
((= (car tam) 1) (setq dsach (append dsach (list text))))
((= (car tam) 10) (setq dsach (append dsach (list vitri10))))
((= (car tam) 11) (setq dsach (append dsach (list vitri11))))
((setq dsach (append dsach (list tam))))
)
)
(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi
 
(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun
 
;*********************************************************************
(defun c:coo ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq luuecho (getvar "cmdecho")
luu *error*
*error* ketthuc
cumdt (ssget)
dodai (sslength cumdt)
goc (getpoint "\nSelect base point:")
thoat nil
dem 0
textxl nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while (and (= thoat nil)
(< dem dodai)
)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)
 
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
       )
(setq thoat T
textxl (cdr (assoc 1 doituong))
)
)
);
(while T 
(setq toi (getpoint "\nSelect next point: " goc)
vitrilech (list (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem 0
)
(while (< dem dodai)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)
 
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
       )
(doitext ten)
(copy_dt ten)
 
);if
)
);while
(ketthuc)
);defun
(princ "Type \"DG\" to start")
;Note: bien toan cuc: textxl vitrilech

  • 0

#30 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 07 August 2014 - 09:56 PM

Bạn tìm trong lisp sẽ có số 100. Sửa nó thành 1000 là OK.


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


#31 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 08 August 2014 - 09:13 AM

Không đơn giản vậy đâu bác HA ơi!! Nếu vậy thì sau số 100 sẽ là số 11!!

Nếu text chỉ là các con số mà không có chữ thì có thể sửa hàm xulytext như thế này:

(defun xulytext (text / sokt luusokt)
  (if (numberp (setq sokt (read text)))
    (progn
      (setq luusokt (1+ sokt))
      (if (= luusokt 1001)
(setq luusokt 1)
      )
      (setq  text (rtos luusokt 2 0)
      )
    )
  )
)

  • 0

#32 PrettyBoy_231988

PrettyBoy_231988

    biết zoom

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

Đã gửi 09 August 2014 - 09:34 AM

Thank mọi người giúp đỡ ! nhưng nếu text cả số kết hợp với nhau vd DT1 --> DT2 --> ... --> DTn mong mọi người sửa lisp dùm


  • 0

#33 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 09 August 2014 - 10:05 AM

Bạn thử cái này. Tôi chỉ sửa hàm xulytext thôi , còn chỗ khác để nguyên.

(defun ketthuc ()
  (setvar "cmdecho" luuecho)
  (setq *error* luu
luu nil
luuecho nil
  ) 
  (princ)
)
 
(defun modau ()
  (setq luu *error
luuecho (getvar "cmdecho")
*error (ketthuc)
  )
)
 
(defun xulytext (text / sokt  )
  (setq sokt (last (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (or (< x 48) (> x 57)) 32 x)) (vl-string->list text))) ")")))
luusokt (1+ sokt))  
  (if (> luusokt 1000)
    (setq luusokt 1)
  )
  (setq text (vl-string-subst (rtos luusokt 2 0) (rtos sokt 2 0) text ))
)
 
(defun doitext (tendoituong     /       chuoi doituong
thoat   tam     dsach     kieu text
vitri10   vitri11   dem       canle
      )
 
  (setq doituong (entget tendoituong)
kieu  (cdr (assoc 0 doituong))
canle  (cdr (assoc 72 doituong))
  )
  (if (or (= kieu "TEXT")
 (= kieu "MTEXT")
      )
    (progn
      (setq textxl  (xulytext textxl)
   text    (cons 1 textxl)
   vitri10 (cdr (assoc 10 doituong))
   vitri10 (list (+ (car vitri10) (car vitrilech))
 (+ (nth 1 vitri10) (nth 1 vitrilech))
   )
   vitri10 (cons 10 vitri10)
   vitri11 (cdr (assoc 11 doituong))
   vitri11 (list (+ (car vitri11) (car vitrilech))
 (+ (nth 1 vitri11) (nth 1 vitrilech))
   )
   vitri11 (cons 11 vitri11)
   dem     0
   dsach   nil
      )
      (foreach tam doituong
(cond
 ((= (car tam) 1) (setq dsach (append dsach (list text))))
 ((= (car tam) 10)
  (setq dsach (append dsach (list vitri10)))
 )
 ((= (car tam) 11)
  (setq dsach (append dsach (list vitri11)))
 )
 ((setq dsach (append dsach (list tam))))
)
      )
      (entmake dsach)
    ) ;progn
  ) ;if
) ;
;*********************************************************************
;sao doi tuong cu sang vi tri moi
 
(defun copy_dt (tendoituong)
  (command "copy" tendoituong "" goc toi)
) ;defun
 
;*********************************************************************
(defun c:coo (/ cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
  (princ "\nCopy Inteligent...\n")
  (setq luuecho (getvar "cmdecho")
luu *error*
*error* ketthuc
cumdt (ssget)
dodai (sslength cumdt)
goc (getpoint "\nSelect base point:")
thoat nil
dem 0
textxl nil
  ) ;
  (setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
  (while (and (= thoat nil)
     (< dem dodai)
)
    (setq ten    (ssname cumdt dem)
 dem    (1+ dem)
 doituong (entget ten)
 kieu    (cdr (assoc 0 doituong))
    )
 
    (if (or (= kieu "TEXT")
   (= kieu "MTEXT")
)
      (setq thoat  T
   textxl (cdr (assoc 1 doituong))
      )
    )
  ) ;
  (while T
    (setq toi     (getpoint "\nSelect next point: " goc)
 vitrilech (list (- (car toi) (car goc))
 (- (nth 1 toi) (nth 1 goc))
   )
 dem     0
    )
    (while (< dem dodai)
      (setq ten      (ssname cumdt dem)
   dem      (1+ dem)
   doituong (entget ten)
   kieu     (cdr (assoc 0 doituong))
      )
 
      (if (or (= kieu "TEXT")
     (= kieu "MTEXT")
 )
(doitext ten)
(copy_dt ten)
 
      ) ;if
    )
  ) ;while
  (ketthuc)
) ;defun
(princ "Type \"DG\" to start")

  • 2

#34 PrettyBoy_231988

PrettyBoy_231988

    biết zoom

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

Đã gửi 11 August 2014 - 01:33 PM

Bạn thử cái này. Tôi chỉ sửa hàm xulytext thôi , còn chỗ khác để nguyên.

 

(defun ketthuc ()
  (setvar "cmdecho" luuecho)
  (setq *error* luu
luu nil
luuecho nil
  ) 
  (princ)
)
 
(defun modau ()
  (setq luu *error
luuecho (getvar "cmdecho")
*error (ketthuc)
  )
)
 
(defun xulytext (text / sokt  )
  (setq sokt (last (read (strcat "(" (vl-list->string (mapcar '(lambda(x) (if (or (< x 48) (> x 57)) 32 x)) (vl-string->list text))) ")")))
luusokt (1+ sokt))  
  (if (> luusokt 1000)
    (setq luusokt 1)
  )
  (setq text (vl-string-subst (rtos luusokt 2 0) (rtos sokt 2 0) text ))
)
 
(defun doitext (tendoituong     /       chuoi doituong
thoat   tam     dsach     kieu text
vitri10   vitri11   dem       canle
      )
 
  (setq doituong (entget tendoituong)
kieu  (cdr (assoc 0 doituong))
canle  (cdr (assoc 72 doituong))
  )
  (if (or (= kieu "TEXT")
 (= kieu "MTEXT")
      )
    (progn
      (setq textxl  (xulytext textxl)
   text    (cons 1 textxl)
   vitri10 (cdr (assoc 10 doituong))
   vitri10 (list (+ (car vitri10) (car vitrilech))
 (+ (nth 1 vitri10) (nth 1 vitrilech))
   )
   vitri10 (cons 10 vitri10)
   vitri11 (cdr (assoc 11 doituong))
   vitri11 (list (+ (car vitri11) (car vitrilech))
 (+ (nth 1 vitri11) (nth 1 vitrilech))
   )
   vitri11 (cons 11 vitri11)
   dem     0
   dsach   nil
      )
      (foreach tam doituong
(cond
 ((= (car tam) 1) (setq dsach (append dsach (list text))))
 ((= (car tam) 10)
  (setq dsach (append dsach (list vitri10)))
 )
 ((= (car tam) 11)
  (setq dsach (append dsach (list vitri11)))
 )
 ((setq dsach (append dsach (list tam))))
)
      )
      (entmake dsach)
    ) ;progn
  ) ;if
) ;
;*********************************************************************
;sao doi tuong cu sang vi tri moi
 
(defun copy_dt (tendoituong)
  (command "copy" tendoituong "" goc toi)
) ;defun
 
;*********************************************************************
(defun c:coo (/ cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
  (princ "\nCopy Inteligent...\n")
  (setq luuecho (getvar "cmdecho")
luu *error*
*error* ketthuc
cumdt (ssget)
dodai (sslength cumdt)
goc (getpoint "\nSelect base point:")
thoat nil
dem 0
textxl nil
  ) ;
  (setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
  (while (and (= thoat nil)
     (< dem dodai)
)
    (setq ten    (ssname cumdt dem)
 dem    (1+ dem)
 doituong (entget ten)
 kieu    (cdr (assoc 0 doituong))
    )
 
    (if (or (= kieu "TEXT")
   (= kieu "MTEXT")
)
      (setq thoat  T
   textxl (cdr (assoc 1 doituong))
      )
    )
  ) ;
  (while T
    (setq toi     (getpoint "\nSelect next point: " goc)
 vitrilech (list (- (car toi) (car goc))
 (- (nth 1 toi) (nth 1 goc))
   )
 dem     0
    )
    (while (< dem dodai)
      (setq ten      (ssname cumdt dem)
   dem      (1+ dem)
   doituong (entget ten)
   kieu     (cdr (assoc 0 doituong))
      )
 
      (if (or (= kieu "TEXT")
     (= kieu "MTEXT")
 )
(doitext ten)
(copy_dt ten)
 
      ) ;if
    )
  ) ;while
  (ketthuc)
) ;defun
(princ "Type \"DG\" to start")

Đúng như ý mình , Thank you !


  • 0