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

[hanhtinhnho 0]

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.com/forum/index.php?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)

)

[pdle 126]

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.com/forum/index.php?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 done và init chưa được định nghĩa. Nếu bỏ nó đi thì em thử qua, vẫn thấy nó chạy được!

[hanhtinhnho 0]

Ôi ! em cảm ơn bác đã chỉ bảo ,

Em làm được rồi ạ

[thanhdatkts 4]

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

[pdle 126]

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