Đến nội dung


Hình ảnh
- - - - -

[Xin giúp chỉnh sửa] Lisp JL - nối 2 đường Line ngắt quãng !


  • Please log in to reply
4 replies to this topic

#1 hanhtinhnho

hanhtinhnho

    biết vẽ circle

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

Đã gửi 01 June 2011 - 02:44 PM

Em chào các bác !
em đang sử dụng Lisp JL ( nối 2 đường Line ngắt quãng ), Lisp này của 1 bro viết ra rất hay và hữu ích ,nhưng hiện h bộ Lisp đó của em tự nhiên bị lỗi và không sử dụng được , vậy em kính mong các bác giứp em sửa lại lỗi của Lisp này được khônhg ạ
Em xin cảm ơn !
Mã lisp đây các bác xem lỗi chỗ nào thì sửa giúp em với :


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...p?showtopic=143
(defun c:jl (/ p1 p2 p3 ssdt entla entlb tt p1a p2a tt p1b p2b layermoi TAPLINEMOI TENLAYERMOI)
(defun thanghang (p0 p1 p2 / dx1 dy1 dx2 dy2 x1 y1 x2 y2 x0 y0)
(setq
x0 (car p0)
y0 (cadr p0)
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
dx1 (- x1 x0)
dy1 (- y1 y0)
dx2 (- x2 x0)
dy2 (- y2 y0)
)
(if (equal (* dx1 dy2) (* dx2 dy1) 0.01)
t
nil
)
)
(defun noiline (p1 p2 p3 p4 / kq dmax)
(if (and (thanghang p1 p2 p3) (thanghang p1 p2 p4))
(progn
(setq d1 (distance p1 p3)
d2 (distance p1 p4)
d3 (distance p2 p3)
d4 (distance p2 p4)
dmax (max d1 d2 d3 d4)
kq (cond
((= dmax d1) (list p1 p3))
((= dmax d2) (list p1 p4))
((= dmax d3) (list p2 p3))
((= dmax d4) (list p2 p4))
(t nil)
)
)
kq
)
nil
)
)
(init)
(setq
p1 (getpoint "\ngocdau: ")
p2 (getcorner p1 "\ngocsau: ")
ssdt (ssget "c" p1 p2 '((0 . "LINE")))
entla (ssname ssdt 0)
entlb (ssname ssdt 1)
tt (entget entla)
p1a (cdr (assoc 10 tt))
p2a (cdr (assoc 11 tt))
tt (entget entlb)
p1b (cdr (assoc 10 tt))
p2b (cdr (assoc 11 tt))
tenlayermoi (cdr (assoc 8 (entget entla)))
)
(if (setq taplinemoi (noiline p1a p2a p1b p2b))
(progn
(command ".erase" ssdt "")
(entmake
(list
(cons 0 "LINE")
(cons 8 tenlayermoi)
(cons 10 (car taplinemoi))
(cons 11 (cadr taplinemoi))
)
)
(traos)
)
(princ "\nKhong the noi line duoc !")
)
(done)
)
  • 0

#2 pdle

pdle

    biết lệnh mtext

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

Đã gửi 01 June 2011 - 02:58 PM

Em chào các bác !
em đang sử dụng Lisp JL ( nối 2 đường Line ngắt quãng ), Lisp này của 1 bro viết ra rất hay và hữu ích ,nhưng hiện h bộ Lisp đó của em tự nhiên bị lỗi và không sử dụng được , vậy em kính mong các bác giứp em sửa lại lỗi của Lisp này được khônhg ạ
Em xin cảm ơn !
Mã lisp đây các bác xem lỗi chỗ nào thì sửa giúp em với :


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...p?showtopic=143
(defun c:jl (/ p1 p2 p3 ssdt entla entlb tt p1a p2a tt p1b p2b layermoi TAPLINEMOI TENLAYERMOI)
(defun thanghang (p0 p1 p2 / dx1 dy1 dx2 dy2 x1 y1 x2 y2 x0 y0)
(setq
x0 (car p0)
y0 (cadr p0)
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
dx1 (- x1 x0)
dy1 (- y1 y0)
dx2 (- x2 x0)
dy2 (- y2 y0)
)
(if (equal (* dx1 dy2) (* dx2 dy1) 0.01)
t
nil
)
)
(defun noiline (p1 p2 p3 p4 / kq dmax)
(if (and (thanghang p1 p2 p3) (thanghang p1 p2 p4))
(progn
(setq d1 (distance p1 p3)
d2 (distance p1 p4)
d3 (distance p2 p3)
d4 (distance p2 p4)
dmax (max d1 d2 d3 d4)
kq (cond
((= dmax d1) (list p1 p3))
((= dmax d2) (list p1 p4))
((= dmax d3) (list p2 p3))
((= dmax d4) (list p2 p4))
(t nil)
)
)
kq
)
nil
)
)
(init)
(setq
p1 (getpoint "\ngocdau: ")
p2 (getcorner p1 "\ngocsau: ")
ssdt (ssget "c" p1 p2 '((0 . "LINE")))
entla (ssname ssdt 0)
entlb (ssname ssdt 1)
tt (entget entla)
p1a (cdr (assoc 10 tt))
p2a (cdr (assoc 11 tt))
tt (entget entlb)
p1b (cdr (assoc 10 tt))
p2b (cdr (assoc 11 tt))
tenlayermoi (cdr (assoc 8 (entget entla)))
)
(if (setq taplinemoi (noiline p1a p2a p1b p2b))
(progn
(command ".erase" ssdt "")
(entmake
(list
(cons 0 "LINE")
(cons 8 tenlayermoi)
(cons 10 (car taplinemoi))
(cons 11 (cadr taplinemoi))
)
)
(traos)
)
(princ "\nKhong the noi line duoc !")
)
(done)
)


Trong lisp này có 2 hàm doneinit chưa được định nghĩa. Nếu bỏ nó đi thì em thử qua, vẫn thấy nó chạy được!
  • 0
Share your knowledge. It is a way to achieve immortality !

***

PS: Nếu bài viết của mình có ích, xin hãy "Bình chọn cho bài viết này" nhé :D

#3 hanhtinhnho

hanhtinhnho

    biết vẽ circle

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

Đã gửi 01 June 2011 - 04:08 PM

Ôi ! em cảm ơn bác đã chỉ bảo ,
Em làm được rồi ạ
  • 0

#4 thanhdatkts

thanhdatkts

    biết vẽ line

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

Đã gửi 25 June 2011 - 09:48 AM

sao mình down về kg sử dụng được nhỉ :blink:
  • 0

#5 pdle

pdle

    biết lệnh mtext

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

Đã gửi 26 June 2011 - 06:46 AM

sao mình down về kg sử dụng được nhỉ :blink:

Anh sử dụng lisp này xem, em thấy dùng ổn!
;;; "Noi cac doan thang" by pdle
(defun c:jl(/ lXY ss e1 e2 i OK )
(prompt "\nChon cac duong thang: ")
(foreach ent (mapcar 'entget (setq ss (acet-ss-to-list(ssget'((0 . "LINE"))))))
(setq lXY (append (list (acet-dxf 10 ent)) (list (acet-dxf 11 ent)) lXY) ) ;setq
); foreach
(if (/= lXY nil)
(progn
(setq i 0 OK T)
(while (and (< i (length lXY)) OK)
(if (equal (- (* (- (car (nth i lXY)) (car (nth 0 lXY)))(- (cadr (nth 1 lXY)) (cadr (nth 0 lXY))))
(* (- (car (nth 1 lXY)) (car (nth 0 lXY)))(- (cadr (nth i lXY)) (cadr (nth 0 lXY))))) 0.0 0.001) (setq OK T) (setq OK nil))
(setq i (1+ i))
); while
(if OK
(progn
(setq lXY (vl-sort lXY (function (lambda (e1 e2) (> (car e1) (car e2))))))
(entmake (list (cons 0 "LINE")(cons 10 (car lXY)) (cons 11 (last lXY))))
(foreach ent ss (entdel ent))
(princ "\nCac doan thang da duoc noi thanh cong!")
) ;progn
(princ "\nCac doan thang khong cung nam tren mot duong thang. Hay kiem tra lai !")
); if
); progn
); if
(princ)
); defun

  • 2
Share your knowledge. It is a way to achieve immortality !

***

PS: Nếu bài viết của mình có ích, xin hãy "Bình chọn cho bài viết này" nhé :D