Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Nhờ các bác viết lisp vẽ đoạn thẳng song song


  • Please log in to reply
8 replies to this topic

#1 satthuvothan

satthuvothan

    biết pan

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

Đã gửi 20 August 2011 - 09:33 AM

Em có đoạn thẳng L1 và 1 pline đường tự nhiên như hình vẽ. Các bác có thể viết giùm em lisp vẽ đoạn L2 song song với L1, cách L1 0,3m, điểm đầu và cuối của L2 là điểm giao với đường pline.
Nếu được thì các bác cho em thêm tùy chọn đoạn L2 trên hoặc dưới L1.
Em cảm ơn các bác nhiều.
Hình đã gửi
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 20 August 2011 - 06:28 PM

Offset rồi trim (nếu thừa) hoặc Shift Trim (nếu thiếu), chứ bạn cần lisp làm gì ??
  • 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 satthuvothan

satthuvothan

    biết pan

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

Đã gửi 20 August 2011 - 08:52 PM

Em có đoạn thẳng L1 và 1 pline đường tự nhiên như hình vẽ. Các bác có thể viết giùm em lisp vẽ đoạn L2 song song với L1, cách L1 0,3m, điểm đầu và cuối của L2 là điểm giao với đường pline.
Nếu được thì các bác cho em thêm tùy chọn đoạn L2 trên hoặc dưới L1.
Em cảm ơn các bác nhiều.
Hình đã gửi

Nếu có lisp thì sẽ bỏ qua được công đoạn trim mất nhiều thời gian vì em có nhiều mặt cắt phải làm như vậy bác ah.
  • 0

#4 satthuvothan

satthuvothan

    biết pan

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

Đã gửi 20 August 2011 - 08:55 PM

Mong được sự giúp đỡ của các bác.
  • 0

#5 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 August 2011 - 11:42 AM

Ớ, hôm qua đến giờ mà chưa bác nào giúp bạn nhỉ. Hôm qua mình say quá, hỏi xong ngủ mất :)
Đầu vào bạn đưa ra còn thiếu : 0,3 là cố định hay có thể thay đổi lúc nhập, Line đưa vào giống hệt Line trước (kiểu offset) hay Line tạo mới như hình ? Layer, màu sắc....
  • 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


#6 satthuvothan

satthuvothan

    biết pan

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

Đã gửi 21 August 2011 - 09:37 PM

Ớ, hôm qua đến giờ mà chưa bác nào giúp bạn nhỉ. Hôm qua mình say quá, hỏi xong ngủ mất :)
Đầu vào bạn đưa ra còn thiếu : 0,3 là cố định hay có thể thay đổi lúc nhập, Line đưa vào giống hệt Line trước (kiểu offset) hay Line tạo mới như hình ? Layer, màu sắc....

Bác để cho em 0,3 có thể thay đổi (lưu lại thông tin với các lần sau), line tạo mới và đưa về layer hiện hành.
Em cảm ơn nhiều.
  • 0

#7 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 22 August 2011 - 10:37 PM

Quick code cho bạn. Mình không bắt lỗi, vì vậy bạn cố gắng kiểm soát đối tượng nhập vào (Line và Pline), khoảng cách offset (vì như hình vẽ của bạn thì Line mới và Pline chỉ có 2 điểm giao, nếu nhiều hoặc ít hơn có thể sai) hoặc nhờ các bác trên diễn đàn giúp thêm 1 tí, thời gian này mình quá bận ^^
(defun c:test ( / di en nm op p1 p2 pt Line Line1 )

;========== Local Functions ===========

(defun dxf (code ent)(cdr(assoc code (entget ent))))
(defun eLine (p1 p2)(entmakex (list (cons 0 "LINE")(cons 62 1)(cons 10 p1)(cons 11 p2))))
(defun ST:IntersObj (e1 e2 objExtend / ob1 ob2 g L i kq opt) ;objExtend : doi tuong keo dai
;0 : khong keo doi tuong nao
;1,2 : doi tuong tuong ung
;3 : ca 2 doi tuong
(vl-load-com)
(setq
ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2))
(cond ((= objExtend 0) (setq opt acExtendNone))
((= objExtend 1) (setq opt acExtendThisEntity ))
((= objExtend 2) (setq opt acExtendOtherEntity ))
((= objExtend 3) (setq opt acExtendBoth ))
)
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 opt)))

(if (/= (vlax-safearray-get-u-bound g 1) -1) (setq L (vlax-safearray->list g)))
(setq i 0)
(repeat (/ (length L) 3)
(setq kq (append (list (list (nth i L) (nth (+ i 1) L) (nth (+ i 2) L))) kq))
(setq i (+ i 3))
)
kq
)

;============== Start Here : ===================

(setq en1 (car (entsel "\nSelect Line to Offset: ")))
(setq en2 (car (entsel "\nPline:")))
(or di (setq di 0.3))
(setq di (cond ((getdist (strcat "\nSpecify Offset Distance < " (rtos di 2 2) " > :")))(di)))
(setq pt (getpoint "\nPick Point on Side to Offset: "))
(setq p1 (dxf 10 en1) p2 (dxf 11 en1) nm (mapcar '- p1 p2) mPnt (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5))
p1 (trans p1 0 nm)
p2 (trans p2 0 nm)
op (if (< (car (trans pt 1 nm)) (car p1)) - +)
mPnt (trans mPnt 0 nm)
d1 (trans (list (op (car mPnt) di) (cadr mPnt) (- (caddr mPnt) 1)) nm 0)
d2 (trans (list (op (car mPnt) di) (cadr mPnt) (+ (caddr mPnt) 1)) nm 0)
Line (eLine d1 d2)
lstPnt (ST:IntersObj Line en2 1)
Line1 (eLine (car lstPnt) (cadr lstPnt))
)
(entdel Line)
)

  • 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


#8 satthuvothan

satthuvothan

    biết pan

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

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

Quick code cho bạn. Mình không bắt lỗi, vì vậy bạn cố gắng kiểm soát đối tượng nhập vào (Line và Pline), khoảng cách offset (vì như hình vẽ của bạn thì Line mới và Pline chỉ có 2 điểm giao, nếu nhiều hoặc ít hơn có thể sai) hoặc nhờ các bác trên diễn đàn giúp thêm 1 tí, thời gian này mình quá bận ^^

(defun c:test ( / di en nm op p1 p2 pt Line Line1 )

;========== Local Functions ===========

(defun dxf (code ent)(cdr(assoc code (entget ent))))
(defun eLine (p1 p2)(entmakex (list (cons 0 "LINE")(cons 62 1)(cons 10 p1)(cons 11 p2))))
(defun ST:IntersObj (e1 e2 objExtend / ob1 ob2 g L i kq opt) ;objExtend : doi tuong keo dai
;0 : khong keo doi tuong nao
;1,2 : doi tuong tuong ung
;3 : ca 2 doi tuong
(vl-load-com)
(setq
ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2))
(cond ((= objExtend 0) (setq opt acExtendNone))
((= objExtend 1) (setq opt acExtendThisEntity ))
((= objExtend 2) (setq opt acExtendOtherEntity ))
((= objExtend 3) (setq opt acExtendBoth ))
)
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 opt)))

(if (/= (vlax-safearray-get-u-bound g 1) -1) (setq L (vlax-safearray->list g)))
(setq i 0)
(repeat (/ (length L) 3)
(setq kq (append (list (list (nth i L) (nth (+ i 1) L) (nth (+ i 2) L))) kq))
(setq i (+ i 3))
)
kq
)

;============== Start Here : ===================

(setq en1 (car (entsel "\nSelect Line to Offset: ")))
(setq en2 (car (entsel "\nPline:")))
(or di (setq di 0.3))
(setq di (cond ((getdist (strcat "\nSpecify Offset Distance < " (rtos di 2 2) " > :")))(di)))
(setq pt (getpoint "\nPick Point on Side to Offset: "))
(setq p1 (dxf 10 en1) p2 (dxf 11 en1) nm (mapcar '- p1 p2) mPnt (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5))
p1 (trans p1 0 nm)
p2 (trans p2 0 nm)
op (if (< (car (trans pt 1 nm)) (car p1)) - +)
mPnt (trans mPnt 0 nm)
d1 (trans (list (op (car mPnt) di) (cadr mPnt) (- (caddr mPnt) 1)) nm 0)
d2 (trans (list (op (car mPnt) di) (cadr mPnt) (+ (caddr mPnt) 1)) nm 0)
Line (eLine d1 d2)
lstPnt (ST:IntersObj Line en2 1)
Line1 (eLine (car lstPnt) (cadr lstPnt))
)
(entdel Line)
)

Em làm được rồi bác ah. Nếu bác rỗi thì chỉnh lại cho e với trường hợp đường giới hạn pline đó là 2 đường khác nhau (1 pline và 1 line)với ạ. Cảm ơn bác nhìu lắm.
  • 0

#9 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 24 August 2011 - 05:58 PM

Như vậy thì thà bạn offset rồi thao tác trim, extend còn nhanh hơn :) Thật đấy . Bạn sử dụng phím Shift nữa 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