Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#2141 huong259

huong259

    biết lệnh refedit

  • Members
  • PipPipPipPipPipPipPip
  • 596 Bài viết
Điểm đánh giá: 350 (khá)

Đã gửi 05 October 2010 - 08:56 PM

em chỉ hỏi để mà hỏi thôi nhưng mà nếu anh gia_bach giả nhời thì em sẽ vui hơn hè hè :cheers:

Vâng ạ! Anh nói trúng ý của em!
  • 0

#2142 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 05 October 2010 - 10:04 PM

Nhưng mà lisp của bác báo lỗi không chạy được. Đến bước chọn gốc toạ độ là báo lỗi. Bác xem lại cái nhìn code của bác hoa cả mắt trả biết sai chỗ nào hề hề.

Chào bác phamngoctukts,
Cái lisp này cải biên từ cái lisp trước, lần này nó không chon point có sẵn nữa mà chọn các đối tượng giao với boundary để xác định point. Sau đó thì làm y như cụ bác ạ.
Một vấn đề mà mình chưa gỡ được chính là việc chọn các đối tượng. Mình đã thử dùng hàm ssget với tùy chọn là "CP" nhưng nó chọn không hết các đối tượng giao với boundary. Vì sao thì mình chưa rõ. Vậy nên lại chơi bài củ chuối là pick chọn đối tượng thì nó lại chạy rất chuẩn. cách pick chọn này mà vớ phải dăm chục anh loằng ngoằng thì cũng mệt, xong mình chưa tìm ra cách chọn nào để có thể chọn tất cả các đối tượng giao với boundary cả bác ạ. (Bác xem trên cái líp của mình sẽ rõ)
Hy vọng bác tìm ra cách chọn có hiệu quả hơn cách của mình.
Chúc bác vui.
Lísp đây ạ

;; free lisp from cadviet.com
(defun c:tdd ( / tmp p1 dlst file opw msg oldos pg p p2 ptlst hlst dplst i j name
obj dplst dplst1 k m n ssp l d pdlst ans )
(command "undo" "be")
(setq dlst (list(strcat "X" "\t" "Y"
;;;;;;;;;;;;;;;;;"\t" "Z"
"\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
p2 (getpoint "\n Chon goc toa do ")
ptlst (list)
hlst (list)
dplst (list)
i 0)
(setvar "osmode" 0)
(if (= p2 nil)
(setq p2 (list 0 0 0))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast)
obj (vlax-ename->vla-object name) )
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i)
ptlst (append ptlst (list p1))
dplst (append dplst (list (list i p1)))
)
(setq i (1+ i))
);;;;;;;;;;;;; End while vlax

;;;;;;;;;;;;;;(setq ssp (ssget "CP" ptlst (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))
(alert "\n Chon cac doi tuong giao voi boundary ")
(setq ssp (ssget ))
(if ssp
(progn
(setq n (sslength ssp)
j 0
) ;;;;;;;;;;;; End setq

(while (< j n)
(setq ent (ssname ssp j)
p0 (giao ent name)
pa (vlax-curve-getparamatpoint obj p0)
)
(setq dplst (append dplst (list (list pa p0))))

(setq j (1+ j))
) ;;;;;;;;;;;; End while j
) ;;;;;;;;;;;; End progn
) ;;;;;;;;;;;;End if ssp
(setq dplst (vl-sort dplst '(lambda (x1 x2) (<= (car x1) (car x2))))
dplst1 (list)
m (length dplst)
k 0
)
(while (< k m)
(if (/= (car (nth k dplst)) (car (nth (1+ k) dplst)) )
(setq dplst1 (append dplst1 (list (nth k dplst))))
)
(setq k (1+ k))
)
(setq dplst dplst1)
(setq pdlst (list))
(foreach l dplst
(setq pdlst (append pdlst (cdr l)))
) ;;;;;;;;;;;;; End foreach l
(foreach d pdlst
(setq dlst (append (list (strcat (rtos (- (car d) (car p2) (car pg)) 2 3)
"\t"
(rtos (- (cadr d) (cadr p2) (cadr pg)) 2 3)
;;;;;;;;;;;;;;;;"\t"
;;;;;;;;;;;;;;;;(rtos (- (caddr d) (caddr p2) (caddr pg)) 2 3)
)
)
dlst)
)
) ;;;;;;;;;;;;;;;;;End foreach d

(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
(progn
(setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
i 0)
)
(setq p nil)
) ;;;;;;;;;;;;;;;;;;;End if
(setq pdlst (append pdlst (list (car pdlst))))
(setq dlst (append (list "\n") dlst))
(setq hlst (append hlst (list pdlst))
dplst (list)
ptlst (list)
) ;;;;;;;;;;;;;;;; End setq
(command "erase" name "")
) ;;;;;;;;;;;;;;;;;;;;; End while p
(foreach lst hlst
;;;;;;;;;;;;;;;;;;;;;;;;(wtxt lst)
)

(setq dlst (reverse dlst))
(setq ;file "d:\\tien\\diem.txt"
opw (open file "w")
)
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun wtxt (lst / )
(setq n (length lst)
i 0)
(repeat (1- n)
(setq goc (angle (nth i lst) (nth (1+ i) lst))
x (- (car (nth i lst)) (car pg))
y (- (cadr (nth i lst)) (cadr pg))
z (- (caddr (nth i lst)) (caddr pg))
pt (polar (list x y z) (- goc (/ pi 2)) 2)
i (1+ i)
)
(if (and (> goc (/ pi 2)) (<= goc (* 3 (/ pi 2))) )
(setq goc (+ goc pi))
)
(command "text" "j" "m" pt 0.5 (* goc (/ 180 pi)) (strcat "(" (rtos x 2 3) "," (rtos y 2 3) ")" ) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Ham tim giao diem giua 2 doi tuong ent1, ent2 ; ename
(defun giao(ent1 ent2 / ob1 ob2 g kq sd)
(Vl-Load-Com)
(setq ob1 (vlax-ename->vla-object ent1)
ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil)
)
(if g
(progn
(setq kq nil
sd (fix (/ (length g) 3))
)
(repeat sd
(setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
g (cdddr g)
)
)
kq
)
nil
)
(if kq (setq gi (nth 0 kq)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2143 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 06 October 2010 - 07:57 AM

Chào bác phamngoctukts,
Cái lisp này cải biên từ cái lisp trước, lần này nó lkho6ng chon point có sẵn nữa mà chọn các đối tượng giao với boundary để xác định point. Sau đó thì làm y như cụ bác ạ.
Một vấn đề mà mình chưa gỡ được chính là việc chọn các đối tượng. Mình đã thử dùng hàm ssget với tùy chọn là "CP" nhưng nó chọn không hết các đối tượng giao với boundary. Vì sao thì mình chưa rõ. Vậy nên lại chơi bài củ chuối là pick chọn đối tượng thì nó lại chạy rất chuẩn. cách pick chọn này mà vớ phải dăm chục anh loằng ngoằng thì cũng mệt, xong mình chưa tìm ra cách chọn nào để có thể chọn tất cả các đối tượng giao với boundary cả bác ạ. (Bác xem trên cái líp của mình sẽ rõ)
Hy vọng bác tìm ra cách chọn có hiệu quả hơn cách của mình.
Chúc bác vui.
Lísp đây ạ

Hề hề hề,
Có giải pháp rồi, không phải pick từng chú nữa. sử dụng hàm ssget với tùy chọn "C" . Tuy nhiên để dùng tùy chọn này phải có hai điểm của khung chọn, do vậy mình xài hàm acet-ent-geomextents có trong bộ express tool để có được hai điểm đó.
Các bác xem nha.

;; free lisp from cadviet.com
(defun c:tdd ( / tmp p1 dlst file opw msg oldos pg p p2 ptlst hlst dplst i j name
obj dplst dplst1 k m n ssp l d pdlst ans )
(command "undo" "be")
(setq dlst (list(strcat "X" "\t" "Y"
;;;;;;;;;;;;;;;;;"\t" "Z"
"\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
p2 (getpoint "\n Chon goc toa do ")
ptlst (list)
hlst (list)
dplst (list)
i 0)
(setvar "osmode" 0)
(if (= p2 nil)
(setq p2 (list 0 0 0))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast)
obj (vlax-ename->vla-object name) )
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i)
ptlst (append ptlst (list p1))
dplst (append dplst (list (list i p1)))
)
(setq i (1+ i))
);;;;;;;;;;;;; End while vlax
(setq dd (car (acet-ent-geomextents name))
cc (cadr (acet-ent-geomextents name))
)
(setq ssp (ssget "C" dd cc (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))
;;;;;;;;;;;;;;(alert "\n Chon cac doi tuong giao voi boundary ")
;;;;;;;;;;;;;;(setq ssp (ssget ))
(if ssp
(progn
(setq n (sslength ssp)
j 0
) ;;;;;;;;;;;; End setq

(while (< j n)
(setq ent (ssname ssp j))
(if (/= ent name)
(setq p0 (giao ent name)
pa (vlax-curve-getparamatpoint obj p0))
)
(setq dplst (append dplst (list (list pa p0))))

(setq j (1+ j))
) ;;;;;;;;;;;; End while j
) ;;;;;;;;;;;; End progn
) ;;;;;;;;;;;;End if ssp
(setq dplst (vl-sort dplst '(lambda (x1 x2) (<= (car x1) (car x2))))
dplst1 (list)
m (length dplst)
k 0
)
(while (< k m)
(if (not (equal (car (nth k dplst)) (car (nth (1+ k) dplst)) 0.0000001) )
(setq dplst1 (append dplst1 (list (nth k dplst))))
)
(setq k (1+ k))
)
(setq dplst dplst1)
(setq pdlst (list))
(foreach l dplst
(setq pdlst (append pdlst (cdr l)))
) ;;;;;;;;;;;;; End foreach l
(foreach d pdlst
(setq dlst (append (list (strcat (rtos (- (car d) (car p2) (car pg)) 2 3)
"\t"
(rtos (- (cadr d) (cadr p2) (cadr pg)) 2 3)
;;;;;;;;;;;;;;;;"\t"
;;;;;;;;;;;;;;;;(rtos (- (caddr d) (caddr p2) (caddr pg)) 2 3)
)
)
dlst)
)
) ;;;;;;;;;;;;;;;;;End foreach d

(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
(progn
(setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
i 0)
)
(setq p nil)
) ;;;;;;;;;;;;;;;;;;;End if
(setq pdlst (append pdlst (list (car pdlst))))
(setq dlst (append (list "\n") dlst))
(setq hlst (append hlst (list pdlst))
dplst (list)
ptlst (list)
) ;;;;;;;;;;;;;;;; End setq
(command "erase" name "")
) ;;;;;;;;;;;;;;;;;;;;; End while p
(foreach lst hlst
;;;;;;;;;;;;;;;;;;;;;;;;(wtxt lst)
)

(setq dlst (reverse dlst))
(setq ;file "d:\\tien\\diem.txt"
opw (open file "w")
)
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun wtxt (lst / )
(setq n (length lst)
i 0)
(repeat (1- n)
(setq goc (angle (nth i lst) (nth (1+ i) lst))
x (- (car (nth i lst)) (car pg))
y (- (cadr (nth i lst)) (cadr pg))
z (- (caddr (nth i lst)) (caddr pg))
pt (polar (list x y z) (- goc (/ pi 2)) 2)
i (1+ i)
)
(if (and (> goc (/ pi 2)) (<= goc (* 3 (/ pi 2))) )
(setq goc (+ goc pi))
)
(command "text" "j" "m" pt 0.5 (* goc (/ 180 pi)) (strcat "(" (rtos x 2 3) "," (rtos y 2 3) ")" ) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Ham tim giao diem giua 2 doi tuong ent1, ent2 ; ename
(defun giao(ent1 ent2 / ob1 ob2 g kq sd)
(Vl-Load-Com)
(setq ob1 (vlax-ename->vla-object ent1)
ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil)
)
(if g
(progn
(setq kq nil
sd (fix (/ (length g) 3))
)
(repeat sd
(setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
g (cdddr g)
)
)
kq
)
nil
)
(if kq (setq gi (nth 0 kq)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2144 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 06 October 2010 - 03:57 PM

Hề hề hề,
Có giải pháp rồi, không phải pick từng chú nữa. sử dụng hàm ssget với tùy chọn "C" . Tuy nhiên để dùng tùy chọn này phải có hai điểm của khung chọn, do vậy mình xài hàm acet-ent-geomextents có trong bộ express tool để có được hai điểm đó.
Các bác xem nha.


;; free lisp from cadviet.com
(defun c:tdd ( / tmp p1 dlst file opw msg oldos pg p p2 ptlst hlst dplst i j name
obj dplst dplst1 k m n ssp l d pdlst ans )
(command "undo" "be")
(setq dlst (list(strcat "X" "\t" "Y"
;;;;;;;;;;;;;;;;;"\t" "Z"
"\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
p2 (getpoint "\n Chon goc toa do ")
ptlst (list)
hlst (list)
dplst (list)
i 0)
(setvar "osmode" 0)
(if (= p2 nil)
(setq p2 (list 0 0 0))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast)
obj (vlax-ename->vla-object name) )
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i)
ptlst (append ptlst (list p1))
dplst (append dplst (list (list i p1)))
)
(setq i (1+ i))
);;;;;;;;;;;;; End while vlax
(setq dd (car (acet-ent-geomextents name))
cc (cadr (acet-ent-geomextents name))
)
(setq ssp (ssget "C" dd cc (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE"))))
;;;;;;;;;;;;;;(alert "\n Chon cac doi tuong giao voi boundary ")
;;;;;;;;;;;;;;(setq ssp (ssget ))
(if ssp
(progn
(setq n (sslength ssp)
j 0
) ;;;;;;;;;;;; End setq

(while (< j n)
(setq ent (ssname ssp j))
(if (/= ent name)
(setq p0 (giao ent name)
pa (vlax-curve-getparamatpoint obj p0))
)
(setq dplst (append dplst (list (list pa p0))))

(setq j (1+ j))
) ;;;;;;;;;;;; End while j
) ;;;;;;;;;;;; End progn
) ;;;;;;;;;;;;End if ssp
(setq dplst (vl-sort dplst '(lambda (x1 x2) (<= (car x1) (car x2))))
dplst1 (list)
m (length dplst)
k 0
)
(while (< k m)
(if (not (equal (car (nth k dplst)) (car (nth (1+ k) dplst)) 0.0000001) )
(setq dplst1 (append dplst1 (list (nth k dplst))))
)
(setq k (1+ k))
)
(setq dplst dplst1)
(setq pdlst (list))
(foreach l dplst
(setq pdlst (append pdlst (cdr l)))
) ;;;;;;;;;;;;; End foreach l
(foreach d pdlst
(setq dlst (append (list (strcat (rtos (- (car d) (car p2) (car pg)) 2 3)
"\t"
(rtos (- (cadr d) (cadr p2) (cadr pg)) 2 3)
;;;;;;;;;;;;;;;;"\t"
;;;;;;;;;;;;;;;;(rtos (- (caddr d) (caddr p2) (caddr pg)) 2 3)
)
)
dlst)
)
) ;;;;;;;;;;;;;;;;;End foreach d

(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
(progn
(setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
i 0)
)
(setq p nil)
) ;;;;;;;;;;;;;;;;;;;End if
(setq pdlst (append pdlst (list (car pdlst))))
(setq dlst (append (list "\n") dlst))
(setq hlst (append hlst (list pdlst))
dplst (list)
ptlst (list)
) ;;;;;;;;;;;;;;;; End setq
(command "erase" name "")
) ;;;;;;;;;;;;;;;;;;;;; End while p
(foreach lst hlst
;;;;;;;;;;;;;;;;;;;;;;;;(wtxt lst)
)

(setq dlst (reverse dlst))
(setq ;file "d:\\tien\\diem.txt"
opw (open file "w")
)
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun wtxt (lst / )
(setq n (length lst)
i 0)
(repeat (1- n)
(setq goc (angle (nth i lst) (nth (1+ i) lst))
x (- (car (nth i lst)) (car pg))
y (- (cadr (nth i lst)) (cadr pg))
z (- (caddr (nth i lst)) (caddr pg))
pt (polar (list x y z) (- goc (/ pi 2)) 2)
i (1+ i)
)
(if (and (> goc (/ pi 2)) (<= goc (* 3 (/ pi 2))) )
(setq goc (+ goc pi))
)
(command "text" "j" "m" pt 0.5 (* goc (/ 180 pi)) (strcat "(" (rtos x 2 3) "," (rtos y 2 3) ")" ) )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Ham tim giao diem giua 2 doi tuong ent1, ent2 ; ename
(defun giao(ent1 ent2 / ob1 ob2 g kq sd)
(Vl-Load-Com)
(setq ob1 (vlax-ename->vla-object ent1)
ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil)
)
(if g
(progn
(setq kq nil
sd (fix (/ (length g) 3))
)
(repeat sd
(setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
g (cdddr g)
)
)
kq
)
nil
)
(if kq (setq gi (nth 0 kq)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Hề hề chào bác Bình hôm qua kiểm tra code của bác thấy lỗi đó mà em cũng không biết khắc phục thế nào. sử dụng ở bản vẽ khác thì OK nhưng sử dụng trong bản vẽ do bạn hdt4151 up lên thì bị lỗi (không giải thích được) kể cả dùng select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh được. Vì vậy em đã tiếp tục phát triển lisp trên theo hướng add point vào các đỉnh và được code như thế này. Nghe có vẻ ngắn hơn của bác nhưng thời gian thì khỏi phải bàn. Với thế hệ máy tính bây giờ thì có lẽ không thành vấn đề với lisp này mà dùng với thế hệ máy ngày xua p1, p2 với số lượng obj nhiều nhiều một chút chắc là đơ luôn.
Bạn hdt4151 dùng thử 2 lisp xem có thấy sự khác biệt gì không nhé.

;; free lisp from cadviet.com
(defun c:tdd ()
(command "undo" "be")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
ssl (ssget "x" '((0 . "line,lwpolyline")))
)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(while (< k (sslength ssl))
(setq pp1 (cdr (assoc 10 (entget (ssname ssl k))))
pp2 (cdr (assoc 11 (entget (ssname ssl k)))))
(command "point" pp1 "point" pp2)
(setq k (1+ k))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast)
i 0
ptlst nil
obj (vlax-ename->vla-object name))
(while (/= (vlax-curve-getPointAtParam obj i) nil)
(setq p2 (vlax-curve-getPointAtParam obj i)
ptlst (append (list p2) ptlst)
i (1+ i))
)
(setq ssp (ssget "CP" ptlst (list (cons 0 "POINT")))
n (sslength ssp)
j 0
)
(setq dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (< j n)
(setq p1 (cdr (assoc 10 (entget (ssname ssp j)))))
(setq e 0)
(repeat (length dlst1)
(if (equal (nth e dlst1) (strcat (rtos (car p1) 2 3) "\t" (rtos (cadr p1) 2 3)) 0.01)
(setq p1 (list 0 0 0))
)
(setq e (1+ e))
)
(if (/= (car p1) 0)
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3)
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
)
(setq j (1+ j))
)
(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
(progn
(setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
i 0)
)
(setq p nil)
)
(command "erase" name "")
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq sspt (ssget "x" '((0 . "point"))))
(command "erase" sspt "")
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
)

  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2145 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 07 October 2010 - 05:48 AM

Hề hề chào bác Bình hôm qua kiểm tra code của bác thấy lỗi đó mà em cũng không biết khắc phục thế nào. sử dụng ở bản vẽ khác thì OK nhưng sử dụng trong bản vẽ do bạn hdt4151 up lên thì bị lỗi (không giải thích được) kể cả dùng select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh được. Vì vậy em đã tiếp tục phát triển lisp trên theo hướng add point vào các đỉnh và được code như thế này. Nghe có vẻ ngắn hơn của bác nhưng thời gian thì khỏi phải bàn. Với thế hệ máy tính bây giờ thì có lẽ không thành vấn đề với lisp này mà dùng với thế hệ máy ngày xua p1, p2 với số lượng obj nhiều nhiều một chút chắc là đơ luôn.
Bạn hdt4151 dùng thử 2 lisp xem có thấy sự khác biệt gì không nhé.


;; free lisp from cadviet.com
(defun c:tdd ()
(command "undo" "be")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt")
p (getpoint "\nChon diem nam trong da giac:")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
ssl (ssget "x" '((0 . "line,lwpolyline")))
)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(while (< k (sslength ssl))
(setq pp1 (cdr (assoc 10 (entget (ssname ssl k))))
pp2 (cdr (assoc 11 (entget (ssname ssl k)))))
(command "point" pp1 "point" pp2)
(setq k (1+ k))
)
(while (/= p nil)
(command "boundary" p "")
(setq name (entlast)
i 0
ptlst nil
obj (vlax-ename->vla-object name))
(while (/= (vlax-curve-getPointAtParam obj i) nil)
(setq p2 (vlax-curve-getPointAtParam obj i)
ptlst (append (list p2) ptlst)
i (1+ i))
)
(setq ssp (ssget "CP" ptlst (list (cons 0 "POINT")))
n (sslength ssp)
j 0
)
(setq dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (< j n)
(setq p1 (cdr (assoc 10 (entget (ssname ssp j)))))
(setq e 0)
(repeat (length dlst1)
(if (equal (nth e dlst1) (strcat (rtos (car p1) 2 3) "\t" (rtos (cadr p1) 2 3)) 0.01)
(setq p1 (list 0 0 0))
)
(setq e (1+ e))
)
(if (/= (car p1) 0)
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3)
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
)
(setq j (1+ j))
)
(setq ans (strcase (getstring "\n Ban muon tiep tuc (y or n): ")))
(if (/= ans "N")
(progn
(setq p (getpoint "\n Hay chon diem thuoc da giac tiep theo")
i 0)
)
(setq p nil)
)
(command "erase" name "")
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq sspt (ssget "x" '((0 . "point"))))
(command "erase" sspt "")
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
)

Chào bạn PhamNgocTu
Như Tue_NV đã nói : Việc Chọn Point như cách của bạn là không ổn
Giả sử như mình có 1 số point tạo trên bản vẽ, trong, trên, ngoài boundary. Lisp lại duyệt qua toàn bộ các POINT trên bản vẽ và xoá "sạch sẽ" chúng. Đó là việc làm không ổn. Hơn nữa với việc chọn POINT như mã lệnh này :
(ssget "CP" ptlst (list (cons 0 "POINT")))
và bạn cho duyệt qua từng POINT thì ngoài khuyết điểm mà Tue_NV nếu trên thì ví dụ như số lượng POINT trong đa tuyến ít thì không sao, nếu mà nhiều thì Líp sẽ chạy chậm vì phải "làm việc" với từng POINT chẳng "dính dáng" đến kết quả chạy của chương trình.

Tue_NV thấy Lisp của bác Bình chạy tốt. Và bạn có thể vui lòng upload file mà bạn viết là nhưng sử dụng trong bản vẽ do bạn hdt4151 up lên thì bị lỗi (không giải thích được) kể cả dùng select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh được. Vì Tue_NV test file bạn hdt4151 đều chạy đúng, có lẽ là file khác. Bạn vui lòng upload nhé.

Cả 2 Lisp của bác Bình và bạn Tú chỉ đúng với PLINE có phân đoạn LINE, nếu là phân đoạn ARC thì không còn đúng nữa.
Ấy chết, mình nhỡ lời, nói toàn khuyết điểm của các bác :cheers: THôi thì cho Tue_NV nói câu chào buổi sáng - Chúc các bác một ngày tốt lành, làm việc hiệu quả - Các bác thật tuyệt vời :cheers:
  • 2

#2146 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 07 October 2010 - 07:47 AM

Chào bạn PhamNgocTu
Như Tue_NV đã nói : Việc Chọn Point như cách của bạn là không ổn
Giả sử như mình có 1 số point tạo trên bản vẽ, trong, trên, ngoài boundary. Lisp lại duyệt qua toàn bộ các POINT trên bản vẽ và xoá "sạch sẽ" chúng. Đó là việc làm không ổn. Hơn nữa với việc chọn POINT như mã lệnh này :
(ssget "CP" ptlst (list (cons 0 "POINT")))
và bạn cho duyệt qua từng POINT thì ngoài khuyết điểm mà Tue_NV nếu trên thì ví dụ như số lượng POINT trong đa tuyến ít thì không sao, nếu mà nhiều thì Líp sẽ chạy chậm vì phải "làm việc" với từng POINT chẳng "dính dáng" đến kết quả chạy của chương trình.

Tue_NV thấy Lisp của bác Bình chạy tốt. Và bạn có thể vui lòng upload file mà bạn viết là nhưng sử dụng trong bản vẽ do bạn hdt4151 up lên thì bị lỗi (không giải thích được) kể cả dùng select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh được. Vì Tue_NV test file bạn hdt4151 đều chạy đúng, có lẽ là file khác. Bạn vui lòng upload nhé.

Cả 2 Lisp của bác Bình và bạn Tú chỉ đúng với PLINE có phân đoạn LINE, nếu là phân đoạn ARC thì không còn đúng nữa.
Ấy chết, mình nhỡ lời, nói toàn khuyết điểm của các bác :cheers: THôi thì cho Tue_NV nói câu chào buổi sáng - Chúc các bác một ngày tốt lành, làm việc hiệu quả - Các bác thật tuyệt vời :cheers:

Chào bác Tue_VN.
Viêc lọc các point có sẵn trên bản vẽ để không bị xoá mất cũng như chọn nhầm thì không khó. Nhưng khi hoàn thành rồi em mới phát hiện ra một nhược điểm là nếu các line này chỉ cắt nhau mà các đỉnh của line này không trùnh nhau thì lisp chạy không đúng. Còn trong file bạn hdt4151 gửi lên thì với lisp lúc trước của bác bình port lên chạy bị thiếu các đỉnh dùng command select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh tiếp xúc với đa giác được (cái này bác có thể giải thích cho em được không). Thank Bác.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2147 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 07 October 2010 - 08:28 AM

Chào bạn PhamNgocTu
Như Tue_NV đã nói : Việc Chọn Point như cách của bạn là không ổn
Giả sử như mình có 1 số point tạo trên bản vẽ, trong, trên, ngoài boundary. Lisp lại duyệt qua toàn bộ các POINT trên bản vẽ và xoá "sạch sẽ" chúng. Đó là việc làm không ổn. Hơn nữa với việc chọn POINT như mã lệnh này :
(ssget "CP" ptlst (list (cons 0 "POINT")))
và bạn cho duyệt qua từng POINT thì ngoài khuyết điểm mà Tue_NV nếu trên thì ví dụ như số lượng POINT trong đa tuyến ít thì không sao, nếu mà nhiều thì Líp sẽ chạy chậm vì phải "làm việc" với từng POINT chẳng "dính dáng" đến kết quả chạy của chương trình.

Tue_NV thấy Lisp của bác Bình chạy tốt. Và bạn có thể vui lòng upload file mà bạn viết là nhưng sử dụng trong bản vẽ do bạn hdt4151 up lên thì bị lỗi (không giải thích được) kể cả dùng select với tuỳ chọn "f" quét qua các đỉnh đa giác cũng không select hết các cạnh được. Vì Tue_NV test file bạn hdt4151 đều chạy đúng, có lẽ là file khác. Bạn vui lòng upload nhé.

Cả 2 Lisp của bác Bình và bạn Tú chỉ đúng với PLINE có phân đoạn LINE, nếu là phân đoạn ARC thì không còn đúng nữa.
Ấy chết, mình nhỡ lời, nói toàn khuyết điểm của các bác :cheers: THôi thì cho Tue_NV nói câu chào buổi sáng - Chúc các bác một ngày tốt lành, làm việc hiệu quả - Các bác thật tuyệt vời :cheers:

Chào bác Tue_NV,
Rất cám ơn bác đã có những lời động viên khích lệ đúng lúc.
Về cái vụ pline có phân đoạn ARC thực tế mình cũng chưa thử, song thiển nghĩ là lisp mình viết vẫn có thể thích ứng do mình phân tích như sau:
1/- Pline có các phân đoạn ARC thì khi dùng lệnh Boundary thì nó vẫn lấy ra được hoán toàn các phân đoạn này và các đỉnh của boundary cũng sẽ lấy được bác ạ. Chỉ có duy nhất một chỗ mình hơi nghi ngờ là các parameter có còn đúng nữa hay không mà thôi.
2/- Về cách xác định các điểm giao cắt thì mình dùng hàm lấy giao điểm của các đối tượng với nhau bất kể đó là đối tương gì trong các đối tượng line. poplyline, lwpolyline, arc, circle, arc , ellipse. Do vậy chắc chắn nó sẽ lấy được giao điểm nếu có. Chỉ còn một lỗi là nó chỉ lấy được một giao điểm trong khi các arc, circle và ellipse thì lại có thể có hai giao điểm với boundary. Về vấn đề này mình cũng đã nghĩ đến, song thiệt nghĩ có nhẽ cũng hiếm gặp nên không tìm cách giải quyết mà nghĩ rằng nếu gặp vậy thì phải break các đường đó ra thành hai đoạn sẽ đơn giản hơn.
Do mình sử dụng cái hàm tìm giao điểm mót được trên diễn đàn nên cũng không biết cách sửa nó để có thể đạt được yêu cầu tìm hết cả các giao điểm của các đường cong.
3/- Việc tập hợp các điểm giao cắt và các đỉnh theo mình là đã xử lý được vấn đề tránh sự trùng lặp nên sẽ không có vấn đề khi ghi ra file nữa.

Cuối cùng, nếu bác không bận lắm có thể gợi ý cho mình cái giải pháp để hoàn thiện cái lisp trên được không.
Cám ơn bác nhiều
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2148 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 07 October 2010 - 06:09 PM

Vì phần mềm mình sử dụng không có chức năng nhập đường cong (arc & spline) nên chỉ dùng Polyline và Line , mình dùng Lisp của bạn Bình chạy ra kết quả rất chính xác, việc viết lisp có thể kết thúc ở đây đc rồi. Thanks 2 bác Bình và Tú rất nhiều ^__^

1 yêu cầu khác (theo như bác Tue_VN nói là lại sinh ra "1 quả trứng vàng khác", hy vọng không ai ném đá mình, hux #___#) là cho sẵn file hình vẽ, không cần pick điểm, lisp tự động pick nhận diện được tất cả các đường boundary và xuất ra toạ độ như vừa rồi, không biết việc này có dễ thực hiện k !? (trường hợp số boundary >50) , trường hợp này rất hiếm gặp nhưng giải quyết được thì bài toán sẽ tự động hoàn toàn, nếu giúp được thì giúp mình luôn nhé :cheers:
  • 0

#2149 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 07 October 2010 - 07:39 PM

Vì phần mềm mình sử dụng không có chức năng nhập đường cong (arc & spline) nên chỉ dùng Polyline và Line , mình dùng Lisp của bạn Bình chạy ra kết quả rất chính xác, việc viết lisp có thể kết thúc ở đây đc rồi. Thanks 2 bác Bình và Tú rất nhiều ^__^

1 yêu cầu khác (theo như bác Tue_VN nói là lại sinh ra "1 quả trứng vàng khác", hy vọng không ai ném đá mình, hux #___#) là cho sẵn file hình vẽ, không cần pick điểm, lisp tự động pick nhận diện được tất cả các đường boundary và xuất ra toạ độ như vừa rồi, không biết việc này có dễ thực hiện k !? (trường hợp số boundary >50) , trường hợp này rất hiếm gặp nhưng giải quyết được thì bài toán sẽ tự động hoàn toàn, nếu giúp được thì giúp mình luôn nhé :cheers:

Bạn dùng code này đi
(if (tạo boundary trước)
(xuất toạ độ là ok)
(bó tay)
)
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2150 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 07 October 2010 - 09:10 PM

Bạn dùng code này đi
(if (tạo boundary trước)
(xuất toạ độ là ok)
(bó tay)
)


Bài đầu tiên minh post ở Topic ngoài chính là bài toán tổng quát nhất ^^
1. Chọn tất cả boundary
2. Xuất ra toạ độ
3. Đặt tên từng điểm cho tất cả các điểm, chuyển toạ độ ở bước 2 thành tên điểm

Nếu để 1 bài toán lớn như vậy sẽ rất khó giải quyết, Lisp các bạn vừa giúp mình giải quyết được 1/3 bước của bài toán (nhưng chiếm 95% công việc), bước 1 tạm thời dùng theo thủ công (pick điểm), còn bước 3 mình giải quyết bằng Excel (chưa đc hoàn chỉnh lắm về thuật toán). Một lần nữa cám ơn các bạn rất nhiều :cheers:
  • 1

#2151 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 07 October 2010 - 10:35 PM

Vì phần mềm mình sử dụng không có chức năng nhập đường cong (arc & spline) nên chỉ dùng Polyline và Line , mình dùng Lisp của bạn Bình chạy ra kết quả rất chính xác, việc viết lisp có thể kết thúc ở đây đc rồi. Thanks 2 bác Bình và Tú rất nhiều ^__^

1 yêu cầu khác (theo như bác Tue_VN nói là lại sinh ra "1 quả trứng vàng khác", hy vọng không ai ném đá mình, hux #___#) là cho sẵn file hình vẽ, không cần pick điểm, lisp tự động pick nhận diện được tất cả các đường boundary và xuất ra toạ độ như vừa rồi, không biết việc này có dễ thực hiện k !? (trường hợp số boundary >50) , trường hợp này rất hiếm gặp nhưng giải quyết được thì bài toán sẽ tự động hoàn toàn, nếu giúp được thì giúp mình luôn nhé :cheers:

Chào bạn hdt4151,
Ném đá thì không nhưng ném trứng thì có đây.
Trước hết bạn phải nhớ rằng lisp chỉ là một công cụ giúp con người chứ nó không phải là con người và cũng không thể thay con người. Không có con người thì auto lisp chứ đến ô tô dép cũng là đồ vô dụng.
Vì thế nếu bạn muốn líp tự nhận dạng các boundary thì bạn phải chỉ cho nó biết cái boundary của bạn nó là cái của nợ như thế nào chứ. Trứng vàng hay trứng ung thì cũng phải có cái tiêu chí để xác định chớ.
Vậy nên bạn phải suy nghĩ cho kỹ và tự nghĩ ra các tiêu chí bạn muốn dùng để xác định cái boundary của bạn thì mới nói chuyện lisp nó giúp bạn. Còn nếu chính bạn cũng chả biết phải làm gì, chả có tiêu chí xác định thì lisp chứ bố lisp nó cũng ị ra đó, chả giúp gì được cho bạn đâu.
Cái gọi là bản vẽ bạn cũng chả thèm post lên thì đừng nghĩ chuyện mọi người có thể giúp bạn tìm ra các tiêu chí khả dĩ mà lisp có thể sử dụng. Đừng ỷ lại như vậy, và cũng đừng bày trò đánh đố người khác như thê.
Mọi người nghĩ sao thì mình không biết nhưng mình thì sẽ không dại dột tự suy luận nữa vì có giời mới biết cái mình nghĩ có giống cái bạn cần hay không??
Mà mình thì chả bao giờ muốn làm một việc vô ích cả. Chừng nào bạn chưa đưa ra được các tiêu chí của bạn và chưa post cái bản vẽ của bạn lên thì chừng đó mình sẽ ngồi chờ thôi. Mong bạn chớ có phiền lòng...
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2152 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 08 October 2010 - 12:21 AM

Hình minh hoạ đây bạn:
http://www.cadviet.com/upfiles/3/v.dwg

Hình vẽ gồm nhiều line giao nhau tạo ra các đa giác, như hình vẽ trên là có 9 đa giác, các đa giác thoã điều kiện: bên trong mỗi đa giác không có đa giác nào cả.

Lisp tự động tìm ra các đa giác đó, và xuất ra được toạ độ các điểm nằm trên đa giác như lisp ban đầu.

Cách tìm tự động các đa giác : ... tạm thời chưa nghĩ ra vì hơi khó về mặt giải thuật +_+ , nhờ bạn nghĩ giúp mình với.

Các bước theo mình nghĩ là cần làm trước:
+ Break line tại giao điểm => chi còn line giao nhau tại điểm đầu và cuối
+ Add point tại 2 đầu của line, xoá point trùng nhau

Làm theo cách này thì rất mất thời gian:
+ Xác định xmin xmax , ymin ymax trong tất cả các point tạo thành 1 miền hình chữ nhật
+ Tìm A= (xi - xj) min , B = (yi - yj)min [A, B lấy theo giá tri tuyệt đối ; i#j ]
Nói rõ hơn là tìm khoảng cách x bé nhất giữa các điểm, khoảng cách y bé nhất ...
+ Đặt C = min( A , B )
+ Pick 1 lưới điểm trong miền hình chữa nhật trên, mỗi điểm cách điểm kế nó 1 khoảng là C (theo phương x hoặc y)
+ Tạo boundary với điểm vửa pick => tạo được đa giác => xuất ra toạ độ (như Lisp trước đó)
+ Xoá các đa giác trùng nhau.
  • 0

#2153 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 08 October 2010 - 12:27 AM

Hình minh hoạ đây bạn:
http://www.cadviet.com/upfiles/3/v.dwg

Hình vẽ gồm nhiều line giao nhau tạo ra các đa giác, như hình vẽ trên là có 9 đa giác, các đa giác thoã điều kiện: bên trong mỗi đa giác không có đa giác nào cả.

Lisp tự động tìm ra các đa giác đó, và xuất ra được toạ độ các điểm nằm trên đa giác như lisp ban đầu.

Cách tìm tự động các đa giác : ... tạm thời chưa nghĩ ra vì hơi khó về mặt giải thuật +_+ , nhờ bạn nghĩ giúp mình với.

Các bước theo mình nghĩ là cần làm trước:
+ Break line tại giao điểm => chi còn line giao nhau tại điểm đầu và cuối
+ Add point tại 2 đầu của line, xoá point trùng nhau

Làm theo cách này thì rất mất thời gian:
+ Xác định xmin xmax , ymin ymax trong tất cả các point tạo thành 1 miền hình chữ nhật
+ Tìm A= (xi - xj) min , B = (yi - yj)min [A, B lấy theo giá tri tuyệt đối ; i#j ]
Nói rõ hơn là tìm khoảng cách x bé nhất giữa các điểm, khoảng cách y bé nhất ...
+ Đặt C = min( A , B )
+ Pick 1 lưới điểm trong miền hình chữa nhật trên, mỗi điểm cách điểm kế nó 1 khoảng là C (theo phương x hoặc y)
+ Tạo boundary với điểm vửa pick => tạo được đa giác => xuất ra toạ độ (như Lisp trước đó)
+ Xoá các đa giác trùng nhau.

Diễn đàn dạo này lỗi quá không thể down file của bạn được. Bạn up lên hot khác đi.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2154 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 08 October 2010 - 12:33 AM

uh, mình up lên host của MF rồi đây :

http://www.mediafire...vg0eubqzaotehsd

Hình JPG:

http://i860.photobuc...dt194_1/v-1.jpg
  • 0

#2155 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 08 October 2010 - 12:41 AM

uh, mình up lên host của MF rồi đây :

http://www.mediafire...vg0eubqzaotehsd

Hình JPG:

http://i860.photobuc.../hdt194_1/v.jpg

Thế này thì vượt khỏi khả năng của mình rồi. Nhường lại các bác khúc xương nay mình bó tay rồi.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2156 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 08 October 2010 - 01:16 AM

uh, mình up lên host của MF rồi đây :

http://www.mediafire...vg0eubqzaotehsd

Hình JPG:

http://i860.photobuc...dt194_1/v-1.jpg

Mình chẳng biết các bác làm gì trước đó, nhưng nhìn hình vẽ của bạn thì có thể làm như vậy :
- 1/ Tìm hàm cắt tất cả các line tại điểm giao
- 2/ dùng lệnh (setq n (entlast)) để nhớ đối tượng cuối vào n
- 3/ dùng lệnh region để tạo các đa giác
- 4/ Tìm tập hợp ss các đối tượng tạo ra sau n cho đến cuối
- 5/ Xóa tất cả trừ ss lại
- 6/ Xóa entlast
  • 0

#2157 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 08 October 2010 - 08:14 AM

Hình minh hoạ đây bạn:
http://www.cadviet.com/upfiles/3/v.dwg

Hình vẽ gồm nhiều line giao nhau tạo ra các đa giác, như hình vẽ trên là có 9 đa giác, các đa giác thoã điều kiện: bên trong mỗi đa giác không có đa giác nào cả.

Lisp tự động tìm ra các đa giác đó, và xuất ra được toạ độ các điểm nằm trên đa giác như lisp ban đầu.

Cách tìm tự động các đa giác : ... tạm thời chưa nghĩ ra vì hơi khó về mặt giải thuật +_+ , nhờ bạn nghĩ giúp mình với.

Các bước theo mình nghĩ là cần làm trước:
+ Break line tại giao điểm => chi còn line giao nhau tại điểm đầu và cuối
+ Add point tại 2 đầu của line, xoá point trùng nhau

Làm theo cách này thì rất mất thời gian:
+ Xác định xmin xmax , ymin ymax trong tất cả các point tạo thành 1 miền hình chữ nhật
+ Tìm A= (xi - xj) min , B = (yi - yj)min [A, B lấy theo giá tri tuyệt đối ; i#j ]
Nói rõ hơn là tìm khoảng cách x bé nhất giữa các điểm, khoảng cách y bé nhất ...
+ Đặt C = min( A , B )
+ Pick 1 lưới điểm trong miền hình chữa nhật trên, mỗi điểm cách điểm kế nó 1 khoảng là C (theo phương x hoặc y)
+ Tạo boundary với điểm vửa pick => tạo được đa giác => xuất ra toạ độ (như Lisp trước đó)
+ Xoá các đa giác trùng nhau.

Hi,
Bài toán của Bạn làm mình liên tưởng đến 1 bài toán tương tự là tìm 1 lưới tam giác,nhưng ở đây lại là vừa tam giác vừa đa giác.
Bài toán tam giác là khá lớn về mặt thuật toán,nó thường giúp tạo lưới trong pp phần tử hữu hạn và 1 vài bài toán khác trong trắc địa.Không biết ở đây có mối liên hệ gì không?
Có lẽ phải mất kha khá thời gian và công sức
Phải kiên trì thôi Bạn nhỉ.
Chúc thành công!
  • 0

#2158 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 08 October 2010 - 11:19 AM

Chào bác Tue_NV,
Rất cám ơn bác đã có những lời động viên khích lệ đúng lúc.
Về cái vụ pline có phân đoạn ARC thực tế mình cũng chưa thử, song thiển nghĩ là lisp mình viết vẫn có thể thích ứng do mình phân tích như sau:
1/- Pline có các phân đoạn ARC thì khi dùng lệnh Boundary thì nó vẫn lấy ra được hoán toàn các phân đoạn này và các đỉnh của boundary cũng sẽ lấy được bác ạ. Chỉ có duy nhất một chỗ mình hơi nghi ngờ là các parameter có còn đúng nữa hay không mà thôi.
2/- Về cách xác định các điểm giao cắt thì mình dùng hàm lấy giao điểm của các đối tượng với nhau bất kể đó là đối tương gì trong các đối tượng line. poplyline, lwpolyline, arc, circle, arc , ellipse. Do vậy chắc chắn nó sẽ lấy được giao điểm nếu có. Chỉ còn một lỗi là nó chỉ lấy được một giao điểm trong khi các arc, circle và ellipse thì lại có thể có hai giao điểm với boundary. Về vấn đề này mình cũng đã nghĩ đến, song thiệt nghĩ có nhẽ cũng hiếm gặp nên không tìm cách giải quyết mà nghĩ rằng nếu gặp vậy thì phải break các đường đó ra thành hai đoạn sẽ đơn giản hơn.
Do mình sử dụng cái hàm tìm giao điểm mót được trên diễn đàn nên cũng không biết cách sửa nó để có thể đạt được yêu cầu tìm hết cả các giao điểm của các đường cong.
3/- Việc tập hợp các điểm giao cắt và các đỉnh theo mình là đã xử lý được vấn đề tránh sự trùng lặp nên sẽ không có vấn đề khi ghi ra file nữa.

Cuối cùng, nếu bác không bận lắm có thể gợi ý cho mình cái giải pháp để hoàn thiện cái lisp trên được không.
Cám ơn bác nhiều

Xìn lỗi bác Tue_NV,
Mình nhầm vì sau khi thử thấy đúng là nếu boundary có phân đoạn cong thì lệnh boundary sẽ không hoạt động được mà phải chuyển qua tạo region. Do khi pick điểm vẫn thấy các đường cong được chọn nên mình cứ nghĩ là nó sẽ vẫn tạo ra boundary theo các đường cong này nhưng thự tế khi enter thì nó trả lới là không tạo được boundary và hỏi có tạo region hay không, nếu yes thì nó trả về region, còn no thì trả về nil.
Lỗi này là do mình dốt về Cad nên chưa hiểu rõ, mong bác đừng giận.
Chào bác.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2159 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 08 October 2010 - 12:11 PM

Hình minh hoạ đây bạn:
http://www.cadviet.com/upfiles/3/v.dwg

Hình vẽ gồm nhiều line giao nhau tạo ra các đa giác, như hình vẽ trên là có 9 đa giác, các đa giác thoã điều kiện: bên trong mỗi đa giác không có đa giác nào cả.

Lisp tự động tìm ra các đa giác đó, và xuất ra được toạ độ các điểm nằm trên đa giác như lisp ban đầu.

Cách tìm tự động các đa giác : ... tạm thời chưa nghĩ ra vì hơi khó về mặt giải thuật +_+ , nhờ bạn nghĩ giúp mình với.

Các bước theo mình nghĩ là cần làm trước:
+ Break line tại giao điểm => chi còn line giao nhau tại điểm đầu và cuối
+ Add point tại 2 đầu của line, xoá point trùng nhau

Làm theo cách này thì rất mất thời gian:
+ Xác định xmin xmax , ymin ymax trong tất cả các point tạo thành 1 miền hình chữ nhật
+ Tìm A= (xi - xj) min , B = (yi - yj)min [A, B lấy theo giá tri tuyệt đối ; i#j ]
Nói rõ hơn là tìm khoảng cách x bé nhất giữa các điểm, khoảng cách y bé nhất ...
+ Đặt C = min( A , B )
+ Pick 1 lưới điểm trong miền hình chữa nhật trên, mỗi điểm cách điểm kế nó 1 khoảng là C (theo phương x hoặc y)
+ Tạo boundary với điểm vửa pick => tạo được đa giác => xuất ra toạ độ (như Lisp trước đó)
+ Xoá các đa giác trùng nhau.

Phương án này không ổn vì giả sử trong tập line này có chứ các line song song với trục tọa độ thì xmin và y min sẽ bằng 0 bạn ạ.

Việc tìm các điểm giao cắt là có thể
Nhét chúng vào một tập hợp và loại bỏ các điểm trùng nhau là có thể
Việc xác định các đa giác hiện hữu từ tập hợp các điểm này là...... khó đấy.
Có thể thực hiện nếu như chấp nhận việc tốn thời gian làm lisp cũng như thời gian chạy máy.

Chúc bạn thành công.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2160 tamkt

tamkt

    biết vẽ ellipse

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

Đã gửi 08 October 2010 - 04:25 PM

Mấy anh giúp e với, có cách nào mà vẽ tỉ lế/20 hay bất kì một tỉ lệ nào mà ko phải tính toán không.
Ví dụ: mở bản vẽ cad lên thì nhập 1000, dim theo tỉ lệ 1/100 thì nó sẽ là 1000.
Bây giờ e muốn nhập 1000 thì tự động cad hiều là 4000 (vì e muốn có bản vẽ ở tỉ lệ 1/20, nghĩa là nhập vào 1 giá trị, sau khi enter thì cad tự động nhân số mình nhập cho 4).
Có anh nào biết cách ko, giúp e với.
  • 0