Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa] lisp vẽ đường thẳng hai đầu


  • Please log in to reply
4 replies to this topic

#1 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 01 November 2012 - 03:39 PM

Mình có lisp này:

(defun C:vdx()
(vl-load-com)
(Prompt "\nCh\U+1ECDn Line, Pline c\U+1EA7n th\U+00EAm m\U+00F3c 2 \U+0111\U+1EA7u: ")
(setq
ss (ssget '((0 . "LINE,LWPOLYLINE,ARC,SPLINE,POLYLINE")))
ent (ssname ss 0) ;Lay ten doi tuong chon ham ssget
)
;-------------------------------------
;Gan gia tri goc
(if (not k0) (setq k0 100));;gan gia tri goc
(setq k (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u d\U+00E0i th\U+00E9p m\U+00F3c: L=<" (rtos k0 2 0) ">")));Nhap doan theo moc
(if (not k) (setq k k0) (setq k0 k))
;-------------------------------------
(setq A (vlax-curve-getStartPoint ent))
(setq B (vlax-curve-getEndPoint ent))
(setq C (list (car A) (+ (cadr A) k)))
(setq D (list (car B) (+ (cadr B) k)))
(command "line" A C "")
(command "pedit" ent "j" (entlast) "" "")
(command "line" B D "")
;(setq vv ("line" B D ""))
(command "pedit" ent "j" (entlast) "" "")
(princ)
)
Chức năng: Vẽ đường thẳng vuông góc 2 đầu với đối tượng chọn
Nhưng lisp lỗi khi đối tượng chọn là đoạn thẳng ?
Nhờ các bạn check giúp cám ơn
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 01 November 2012 - 03:49 PM

Bạn thêm dòng này vào đầu lisp
(setvar 'peditaccept 1)
Nguyên nhân thì bạn code nhiều, chắc cũng đã dùng sendcommand, những vấn đề này chắc k xa lạ nữa.
Theo mình thì bạn nên chuyển nó thành hàm làm việc với nhiều đối tượng - và đi mót lisp dần đi thôi ^^
  • 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


#3 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 01 November 2012 - 04:09 PM


(foreach ent entlst
(setq A (vlax-curve-getStartPoint ent))
(setq B (vlax-curve-getEndPoint ent))
(setq C (list (car A) (+ (cadr A) k)))
(setq D (list (car B) (+ (cadr B) k)))
(command "erase" ent "")
(command "Pline" C A B D "" )
(ssdel ent ss)
)
Cho mình hỏi cách khử biến trong vòng lặp này
Vì sau mỗi vòng nó lại gán Ai+1 bằng Ai
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 01 November 2012 - 04:20 PM

Ai+1 hay Ai đâu, là cái j? Bạn khử cái j ? Hàm foreach nhàn lắm mà bạn. Mà đọc qua thì thấy bạn phải chú ý phần line chéo nhé ^^
  • 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


#5 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 01 November 2012 - 09:44 PM

Cái lisp của mình thực hiện không ổn định. có bản vẽ được, bản không ?

(defun C:mocthep()
(vl-load-com)
(setvar 'peditaccept 1)
;Gan gia tri goc
(if (not k0) (setq k0 100));;gan gia tri goc
(setq k (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u d\U+00E0i th\U+00E9p m\U+00F3c: L=<" (rtos k0 2 0) ">")));Nhap doan theo moc
(if (not k) (setq k k0) (setq k0 k))
(Prompt "\nCh\U+1ECDn Line, Pline c\U+1EA7n th\U+00EAm m\U+00F3c 2 \U+0111\U+1EA7u: ")
;(setq
;ss (ssget '((0 . "LINE,LWPOLYLINE,ARC,SPLINE,POLYLINE")))
;ent (ssname ss 0) ;Lay ten doi tuong chon ham ssget
;)
;-------------------------------------
(setq ss (ssget '((0 . "*LINE,LWPOLYLINE,POLYLINE"))))
(vl-load-com)
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(foreach ent entlst
;-------------------------------------
(setq A (vlax-curve-getStartPoint ent))
(setq B (vlax-curve-getEndPoint ent))
(setq C (list (car A) (+ (cadr A) k)))
(setq D (list (car B) (+ (cadr B) k)))
(command "line" A C "")
(command "pedit" ent "j" (entlast) "" "")
(command "line" B D "")
(command "pedit" ent "j" (entlast) "" "")
(ssdel ent ss)
)
(princ)
)

  • 0