Đến nội dung


Hình ảnh
- - - - -

Lệnh offset đặc biệt


  • Please log in to reply
55 replies to this topic

#21 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5684 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 09 April 2011 - 09:00 AM

Không khó khăn lắm :) Của bạn đây. Chúc bạn vui vẻ
(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(setq dist (getdist "\nKhoang cach offset: "))
(princ "\nChon doi tuong offset ")
(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(initget (+ 2 4) "Yes No")
(setq kwrd (getkword "\nXoa doi tuong goc hay khong [Yes/No] : "))
(if (null kwrd)
(setq kwrd "No")
)
(foreach obj objlst
(vla-offset obj dist)
(setq entlst1 (cons (vlax-ename->vla-object (entlast)) entlst1))
(vla-offset obj (* dist -1))
(setq entlst2 (cons (vlax-ename->vla-object (entlast)) entlst2))
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst1)
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst2)
(if (eq kwrd "Yes")
(vla-erase obj)
)
)
)
)
(princ)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#22 M@trixs

M@trixs

    biết pan

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

Đã gửi 02 August 2011 - 03:11 PM

Không khó khăn lắm :) Của bạn đây. Chúc bạn vui vẻ

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(setq dist (getdist "\nKhoang cach offset: "))
(princ "\nChon doi tuong offset ")
(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(initget (+ 2 4) "Yes No")
(setq kwrd (getkword "\nXoa doi tuong goc hay khong [Yes/No] : "))
(if (null kwrd)
(setq kwrd "No")
)
(foreach obj objlst
(vla-offset obj dist)
(setq entlst1 (cons (vlax-ename->vla-object (entlast)) entlst1))
(vla-offset obj (* dist -1))
(setq entlst2 (cons (vlax-ename->vla-object (entlast)) entlst2))
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst1)
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst2)
(if (eq kwrd "Yes")
(vla-erase obj)
)
)
)
)
(princ)
)


Lệnh này hay quá..... Nhưng có ai giúp mình thêm dòng code cho nó ghi nhớ giá trị Ofset mình vừa nhập không ???

Giúp mình với nhé, mình nghĩ chắc nhiều người cũng cần. Chân thành cảm ơn !!
  • 0

#23 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5684 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 02 August 2011 - 03:36 PM

Lệnh này hay quá..... Nhưng có ai giúp mình thêm dòng code cho nó ghi nhớ giá trị Ofset mình vừa nhập không ???

Giúp mình với nhé, mình nghĩ chắc nhiều người cũng cần. Chân thành cảm ơn !!

Của bạn đây :
(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(or #dist(setq #dist 110))
(setq dist (getdist (strcat "\nKho\U+1EA3ng c\U+00E1ch Offset : < " (rtos #dist 2 1) " >: ")))
(if dist (setq #dist dist))
(princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Offset :")
(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(initget (+ 2 4) "c k")
(setq kwrd (getkword "\nXoa doi tuong goc hay khong [C/K] : "))
(if (null kwrd)
(setq kwrd "k")
)
(foreach obj objlst
(vla-offset obj #dist)
(setq entlst1 (cons (vlax-ename->vla-object (entlast)) entlst1))
(vla-offset obj (* #dist -1))
(setq entlst2 (cons (vlax-ename->vla-object (entlast)) entlst2))
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst1)
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst2)
(if (eq kwrd "c")
(vla-erase obj)
)
)
)
)
(princ)
)

Chú ý là nếu bước hỏi có xóa đối tượng gốc hay không, bạn có thể ấn Space (mặc định là không )
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#24 790312

790312

    biết lệnh fillet

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

Đã gửi 02 August 2011 - 07:38 PM

Của bạn đây :

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(or #dist(setq #dist 110))
(setq dist (getdist (strcat "\nKho\U+1EA3ng c\U+00E1ch Offset : < " (rtos #dist 2 1) " >: ")))
(if dist (setq #dist dist))
(princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Offset :")
(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(initget (+ 2 4) "c k")
(setq kwrd (getkword "\nX\U+00F3a \U+0111\U+1ED1i t\U+01B0\U+1EE3ng g\U+1ED1c kh\U+00F4ng ? [C/K] "))
(if (null kwrd)
(setq kwrd "K")
)
(foreach obj objlst
(vla-offset obj #dist)
(setq entlst1 (cons (vlax-ename->vla-object (entlast)) entlst1))
(vla-offset obj (* #dist -1))
(setq entlst2 (cons (vlax-ename->vla-object (entlast)) entlst2))
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst1)
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst2)
(if (eq kwrd "C")
(vla-erase obj)
)
)
)
)
(princ)
)

Chú ý là nếu bước hỏi có xóa đối tượng gốc hay không, bạn có thể ấn Space (mặc định là không )

Khi hỏi có xoá đối tượng gốc hay không?Nhấn C thì nó vẫn không xoá đối tượng gốc.Nhờ bạn xem lại giúp.Thanks.

Đã up lại code

Bài viết đã được chỉnh sửa nội dung bởi ketxu: 02 August 2011 - 10:47 PM

  • 0

#25 leejang

leejang

    biết lệnh move

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

Đã gửi 02 August 2011 - 07:46 PM

Bạn dùng thử cái này


(defun c:o2p()
(setq ob (vlax-ename->vla-object(car(entsel"\n chon doi tuong de offset: ")))
kc (* (getreal"\n Nhap khoang cach offset: ") 2)
sp (vlax-safearray->list(vlax-variant-value(vla-get-startpoint ob)))
ep (vlax-safearray->list(vlax-variant-value(vla-get-endpoint ob))))
(command "Mline" "j" "z" "s" kc sp ep "")
(command "explode" "l" "")
)

Em thì chỉ dùng trong khi vẽ thép. Vậy bác chỉnh giúp em để đối tượng mới sinh ra thuộc layer "THEP", và đối tượng có màu 4 được ko ạ ?
  • 0

#26 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 04 May 2013 - 09:31 PM

Các bạn có thể viết giúp lisp ofset liên tục khi nhập vào khoảng cách: 10,2@20,50 không ?

Cám ơn!


  • 0

#27 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 04 May 2013 - 09:41 PM

Các bạn có thể viết giúp lisp ofset liên tục khi nhập vào khoảng cách: 10,2@20,50 không ?

Cám ơn!

"ofset liên tục khi nhập vào khoảng cách: 10,2@20,50"

 

thì số 10,2@20,50 nghĩa là gì hở bạn??

Bạn vui lòng nói rõ


  • 1

#28 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 04 May 2013 - 09:54 PM

Ví dụ như sau:

1.Chọn đường thẳng

2.Chọn hướng ofset

3.Nhập vào khoảng cách: 10,2@20,50

Kết quả tạo ra 4 đối tượng cách đối tượng gốc là: 10,30,50,100

Cám ơn!


  • 0

#29 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 04 May 2013 - 10:28 PM

(defun C:dof(/ lstDis obj)
(setq lstDIS '(9 10 -15))
(while (setq obj (car (entsel "\nSelect object:")))
(foreach dis lstDIS
(vla-offset (vlax-ename->vla-object obj) dis)
)
)
(princ)
)

Code này mình sưu tầm được nó cho phép Off như trên. Nhưng chưa hiện thị nhập giá trị từ bàn phím và xử lý có khoảng cách @


  • 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 04 May 2013 - 11:38 PM

Lisp ofset liên tục khi nhập vào khoảng cách.

 

;Doan Van Ha - CADViet.com - Ngay 04/05/2013
;Chuc nang: Offset lien tuc theo string nhap vao. VD: str = "10,2@20,50" => Offest: 10, 30, 50, 100.
(defun C:HA(/ lst ent)
 (vl-load-com)
 (setq str (getstring "\Nhap bieu thuc gia tri offset: "))
 (setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))
 (while (setq ent (car (entsel "\nChon doi tuong de offset: ")))
  (foreach dis lst
   (vla-offset (vlax-ename->vla-object ent) dis)
   (setq ent (entlast))))
 (princ))
(defun LM:str->lst (str del / pos)
 (if (setq pos (vl-string-search del str))
  (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
  (list str)))
(defun HA:str->lst (str del / lst1)
 (setq lst (LM:str->lst str del))
 (if (= (length lst) 1)
  (mapcar 'atof lst)
  (repeat (atoi (car lst))
   (setq lst1 (cons (atof (cadr lst)) lst1)))))

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


#31 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 04 May 2013 - 11:48 PM

Cám ơn bác nhiều

Sau khi mò mẫm về cơ bản mình sử lý được 70%, còn cái vụ tách @ hàm hay thật

(defun C:dof(/ lstDis obj cc)
;(setq lstDIS '(9 10 -15))
;(setq lstDIS (str->lst "9 10 15 " " ")) 
(setq cc (getstring (strcat"\nNhap cac khoang cach:")))
(setq lstDIS (str->lst  cc ",")) 
;(while (setq obj (car (entsel "\nSelect object:")))
(setq obj (car (entsel "\nSelect object:")))
(setq kc 0)
(foreach dis lstDIS
'(vla-offset (vlax-ename->vla-object obj) dis)
(setq kc (+ kc (atof dis)))
(vla-offset (vlax-ename->vla-object obj) kc)
)
;)
(princ)
)

(defun Str->lst ( str del / pos )
(vl-remove ","
	(if (setq pos (vl-string-search del str))
    	(cons (substr str 1 pos) (Str->lst (substr str (+ pos 1 (strlen del))) del))
    	(list str)
	)
)
)
@ ĐVH có thể giải thích giúp đoạn code sau ?

(setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))

  • 0

#32 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 05 May 2013 - 06:39 AM

(defun C:dof(/ lstDis obj)
(setq lstDIS '(9 10 -15))
(while (setq obj (car (entsel "\nSelect object:")))
(foreach dis lstDIS
(vla-offset (vlax-ename->vla-object obj) dis)
)
)
(princ)
)

Code này mình sưu tầm được nó cho phép Off như trên. Nhưng chưa hiện thị nhập giá trị từ bàn phím và xử lý có khoảng cách @

 

Thêm 1 đoạn code nữa :

 

 
(defun c:olt(/ str)
  (vl-load-com)
  (defun Str_Split(str sym / lst i)
  ;write by Tue_NV
  (while (setq i (vl-string-search sym str 0))
    (setq lst (append lst (list (substr str 1 i)))
      i (+ i 1 (strlen sym))  str (substr str i (strlen str) ) )
  )
 (append lst (list (substr str 1 (strlen str))))
)
  (setq str (getstring "Chuoi Offset \"#,#@#,#\"  : "))
  (setq dt (car(entsel "\ndoi tuong can offset :")))
(foreach y
    (apply 'append
       (mapcar '(lambda(x / a lst) 
  (if (wcmatch x "*#`@#*")
    (progn (setq a (last (STR_SPLIT x "@"))) (Repeat (atoi x) (setq lst (append lst (list a)))) ) (list x) ))
(STR_SPLIT str ",")) )  
    (vla-offset (vlax-ename->vla-object dt) (atof y))
    (setq dt (entlast))
)
)

  • 1

#33 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 05 May 2013 - 07:52 AM

Cám ơn bác nhiều. Nhưng có lẽ cần phải bổ sung thêm tính năng Pick chọn hướng offset. (nghĩa là pick chọn điểm về 1 phía của đối tượng chọn)


  • 0

#34 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 05 May 2013 - 09:28 AM

Cám ơn bác nhiều. Nhưng có lẽ cần phải bổ sung thêm tính năng Pick chọn hướng offset. (nghĩa là pick chọn điểm về 1 phía của đối tượng chọn)

 Đây ban

 
(defun c:olt(/ st dt str lst-num)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (defun Str_Split(str sym / lst i)
  ;write by Tue_NV
  (while (setq i (vl-string-search sym str 0))
    (setq lst (append lst (list (substr str 1 i)))
      i (+ i 1 (strlen sym))  str (substr str i (strlen str) ) )
  )
 (append lst (list (substr str 1 (strlen str))))
)
  (setq str (getstring "Chuoi Offset \"#,#@#,#\"  : "))
  (setq dt (car(entsel "\ndoi tuong can offset :")) pt (getpoint "\nHuong Offset :")) 
(Repeat (length (setq lst-num (reverse 
       (apply 'append
        (mapcar '(lambda(x / a lst) 
     (if (wcmatch x "*#`@#*")
          (progn (setq a (atof (last (STR_SPLIT x "@")))) (Repeat (atoi x) (setq lst (append lst (list a)))) ) (list (atof x)) ))
(STR_SPLIT str ",")) ) )  ) )  
     (command "offset" (apply '+ lst-num) dt "_non" pt "e")
     (setq lst-num (cdr lst-num))
)
(princ)
)

  • 1

#35 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 05 May 2013 - 10:46 AM

Cám ơn. Giả sử bây giờ đối tượng là Block thì việc xử lý có phức tạp không ?

Thân !


  • 0

#36 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 05 May 2013 - 10:49 AM

Offset block? Trong block có nhiều thứ thì offset ra ră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.


#37 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 05 May 2013 - 10:59 AM

Không ý mình dạng như thế nghĩa là như sau:

1.Chọn đối tượng Block

2.Nhập vào khoảng cách: 10,2@50,...

3.Sau đó cái Block sẽ được copy theo số lần

Với cái lisp HA ở trên mình đang tìm xem có hàm Vla-Copy không để thay thế xử lý chắc là ổn ?


  • 0

#38 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 05 May 2013 - 11:10 AM

Không ý mình dạng như thế nghĩa là như sau:

1.Chọn đối tượng Block

2.Nhập vào khoảng cách: 10,2@50,...

3.Sau đó cái Block sẽ được copy theo số lần

Với cái lisp HA ở trên mình đang tìm xem có hàm Vla-Copy không để thay thế xử lý chắc là ổn ?

 

4. Copy mà không có hướng (góc) copy thì làm sao mà cóp?

Cóp khác với Offset nhé.

 

Cái này mình nghĩ bạn tự xây dựng được. Đã có hướng tách chuỗi để lấy chiều dài rồi, Nhập thêm cái hướng để copy nữa là được. Bạn tự làm xem sao.


  • 0

#39 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 05 May 2013 - 11:10 AM

Đúng rồi! Bạn dùng vla-copy, chú ý nó có 3 tham số nhé.


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


#40 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 05 May 2013 - 11:13 AM

Đúng rồi! Bạn dùng vla-copy, chú ý nó có 3 tham số nhé.

 

vla-copy làm gì có tới 3 tham số lận bác? (1 tham số thôi)


  • 0