TRUNGNGAMY
-
Số lượng nội dung
410 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
2
Bài đăng được đăng bởi TRUNGNGAMY
-
-
Rất cảm ơn bạn.Mình đã làm được.Bạn có thể bổ sung them tính năng như sau trong lisp vẽ lưới tam giác cho mình được không:
1. Chọn text mẫu và quét, lisp sẽ lọc các đối tượng như text mẫu để vẽ lưới tam giác
2. Bổ sung tính năng đặt tên cho layer lưới tam giác khi tạo ra để quản lý ( ở đây bạn mặc định sẵn, mình có khi tạo 2 lưới tam giác trong cùng 1 bản vẽ nên càn tính năng này)
Hai vđ này bạn tự làm cũng đc.
1-Đầu tiên bạn chọn các đt mình muốn bằng cách nào đó. Sau đó gọi lệnh DH, khi đc hỏi select objects: hảy chọn "p" là đc
2- Sau khi layer đc tạo bạn hãy đổi tên nó thành tên bạn muốn
Bạn cũng có thể sd cái lisp của người Nga do bạn thanhduan2407 đưa lên, mình thấy nó chạy cũng tương tự nhau, kể cả thời gian
-
Bạn test xem đúng yêu cầu không nhé.
(defun C:HA1() (command "zoom" "e") (princ "\nChuong trinh dang chay. Xin vui long doi...\n") (setq hcnlst (mapcar '(lambda (x) (list (car x) (cadr x))) (select-c (getvar "extmin") (getvar "extmax") 500 '((0 . "LINE")))))) (defun select-c (p1 p2 n filter) (if (setq ss (ssget "c" p1 p2 filter)) (if (< (sslength ss) (abs (setq n (* -1 n)))) (list (list p1 p2)) (if (< n 0) (append (select-c p1 (list (* 0.5 (+ (car p2) (car p1))) (cadr p2)) n filter) (select-c p2 (list (* 0.5 (+ (car p2) (car p1))) (cadr p1)) n filter)) (append (select-c p1 (list (car p2) (* 0.5 (+ (cadr p2) (cadr p1)))) n filter) (select-c p2 (list (car p1) (* 0.5 (+ (cadr p2) (cadr p1)))) n filter)))))) (defun C:HA2() (setq p (getpoint "\nPick point: ")) (setq lst1 '()) (foreach hcn hcnlst (if (not (HA:InOut hcn p)) (setq lst1 (cons hcn lst1)))) lst1) (defun HA:InOut (hcn p / lst tt z n) (setq lst (list (list (car (cadr hcn)) (cadr (cadr hcn))) (car hcn) (list (car (car hcn)) (cadr (cadr hcn))) (cadr hcn))) (setq z 0) (repeat (1- (length lst)) (if (< (sin (- (angle p (nth z lst)) (angle p (nth (1+ z) lst)))) -1e-14) (setq n T)) (setq z (1+ z))) n)Hôm nay mình bắt đầu dùng đến hai cái hàm nhờ bạn viết đã lâu, kg biết bạn còn nhớ kg nữa.
Mình nhắc lại một tý. Căn cứ vào hàm phân nhỏ tập hợp chọn bằng cách chia ô của bác Thai, mình có nhờ và bạn đã viết giúp 2 hàm ở #53 và #52.
- Hàm thứ nhất căn cứ vào các hình chữ nhất có trên bv sau khi chia ô, người sd cung cấp 1 điểm, nó trả về ename HCN bao quanh nó. Hàm này mình đã kiểm tra, kq khá chính xác.
- Hàm thứ hai mình yêu cầu là kg vẽ ra HCN mà chỉ căn cứ vào list lưu HCN thôi, người sd cung cấp 1 điểm, yêu cầu hàm trả về hai đỉnh HCN. Hàm này chạy chưa chính xác lắm. Có lúc nó trả về nil mặc dù điểm chọn nắm bên trong các đt. Nếu bạn có thới gian hoặc lúc nàio rãnh rỗi xin xem lại giúp cho nó chạy tốt. Sau đó chỉnh lại giúp mình một tý, thay vì trả vể hai đỉnh HCN thì chỉ cần trả về vỉ trí của nó trong cái list kia thôi. Cám ơn bạn.
Thật ra mình cũng có viết một hàm tương tự như vậy, nhưng hàm này thường xuyên đc sd nên mình muốn chọn một cái thật nhanh. code như sau :
;Ham kiem tra vi tri ddiem va HCN (defun diemvaHCN( p1 p2 p / x y x1 y1 x2 y2 k) (setq x (car p) y (cadr p) x1 (car p1) y1 (cadr p1) x2 (car p2) y2 (cadr p2)) (if (> x1 x2) (setq k x1 x1 x2 x2 k)) (if (> y1 y2) (setq k y1 y1 y2 y2 k)) (cond ((if (or (< x x1) (< y y1) (> x x2) (> y y2)) 1)) ; khi p nam ngoai HCN (p1 p2) ((if (and (> x x1) (< x x2) (> y y1) (< y y2)) -1)) ; khi p nam trong HCN (p1 p2) (T 0) ; khi p nam trung HCN (p1 p2) ) ) ;Tim vi tri diem thuoc ô HCN nao (defun diemvaHCNchiaO( p / i ds dstam kt) (if (null ltd_dsHCNchiao) (setq ltd_dsHCNchiao (sschiao))) (setq dstam ltd_dsHCNchiao) (setq i 0 ds (car dstam) kt 1) (while (and ds (> (setq kt (diemvahcn (car ds) (cadr ds) p)) 0)) (setq i (1+ i)) (setq dstam (cdr dstam)) (setq ds (car dstam)) ) (if (<= kt 0) i nil) ) ;ham tao list hcn theo o (defun SSCHIAO( / ss box p1 p2 lis) (if (setq ss (ssget "x" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (progn ; (setq box (ACET-GEOM-SS-EXTENTS-FAST ss) p1 (car box) p2 (cadr box)) (setq p1 (getvar "extmin") p2 (getvar "extmax")) (command "_.zoom" p1 p2) (setq lis (select-c p1 p2 200 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) lis) nil) )
Nếu bạn nào có giải thuật thật nhanh thì xin giúp mình. Cám ơn
-
Bạn gởi Lisp xây dựng lưới tam giác đó cho mọi người tham khảo được không? Để tham khảo cách viết của bạn nhé! Mình có lisp xây dựng lưới tam giác từ tập hợp text cao độ trong acad nhưng chưa chạy nhanh được, mình đang xem lại thuật toán. Các bạn có thể load về tham khảo nhé! http://www.cadviet.com/upfiles/3/3989_ve_luoi_tam_giac.lspĐúng là lisp chạy lâu thật.
Mình thấy bạn nên thay đoạn
(setq vertexlist (reverse (append (reverse vertexlist) (list P))))
thành
(setq vertexlist (cons p vertexlist))
sẽ giúp việc tạo danh sách đc nhanh hơn chút ít.
Tuy nhiên, để cải tiến bạn cần xem lại code của mình như bạn lethaonguyen đã góp ý.
Bạn cũng có thể nói rõ hơn vị trí mà code ở đó theo bạn là chạy chậm để mọi người có thể giúp bạn.
Để rút ngắn thời gian thì có nhiều cách (phần cứng, phần mềm và giải thuật), trong đó giải thuật là rất quan trọng, (như bạn lethaonguyen đã làm đc, rất hay). Nếu bạn có thể kết hợp với ý tưởng của PP chia ô (như mình đã nêu trong một chủ đề) thì bạn sẽ giảm tốc độ đáng kể.
-
Cảm ơn Ha nhe,đúng là đổi lại thì được.Không hiểu tại sao nhỉ?
Nên dùng cái tên hệ thống đặt cho nó. Thay vì viết vhelven.ttf hay vhelven_0.ttf bạn hãy dùng VNI-Helve
-
Ý tưởng sắp thành rồi. Mình đã chạy thử đối với TH toàn line, nhanh và độc hơn cad là cái chắc. Tốc độ kg thay đổi ở mọi độ zoom màn hình, đối tượng cần tìm đường bao kg cần nhìn thấy, kể cả cái điểm định vị đầu tiên, có thể chạy nhanh trên bv 50000đt. Hiện nay chỉ cần các bác hỗ trợ góp ý thêm cho TH có cung tròn, elip, spline nữa là có thể hoàn chỉnh. Các bạn nhìn hình bên dưới :
Xét tại điểm A gồm có line, arc, spline. Làm thế nào xuất phát từ cái line màu đỏ để tìm về cái line màu trắng. mình dự định tại a vẽ các đoạn thẳng thuộc curve cách A một đoạn sau đó xét góc như TH đoạn thẳng, nhưng mình chưa quen một số hàm vl để làm việc này cho nhanh. Bạn nào có thể giúp mình với.
Sau khi hình thành cái hình khép kin gồm line, arc, spline thì nên sd cách nào để tính diện tích. Nếu trả cho cad tạo dg bao rồi tính thì kg hay lắm
Cám ơn các bạn
-
Hiện em đang dùng cad overlay 2000i để số hóa bình đồ từ bình đồ giấy
Vướng mắc: đường đồng mức sau khi vẽ không được cong như đường đồng mức bình thường, cứ gãy khúc
Yêu cầu nhờ vả các bác: viết cho em lisp để cho đường đồng mức uốn lượn tương tự đường đồng mức bình thường, có thể xuất hiện sai số cao độ khi làm cong nhưng không sao
Cảm ơn các bác trướchttp://www.cadviet.c..._binh_do_so.dwg
Bạn thử dùng lệnh pedit để chuyển nó qua spline xem có đc kg
-
1
-
-
Cái khoá đó đây nè:
Bạn dùng CAD2012 thử Move-Rotate-Scale-ALign-Stretch đoạn Line này thử xem:
Nó kg có tác dụng với cad2008 trở xuống thì phải
-
Mình vừa mới dọn dẹp xong post lên để các bạn tiện tham khảo
(defun frac( real) (abs (- (abs real) (abs (fix real)))) ) ; lay phan tu theo so hieu tu thuc the (defun diem( name n) (cdr (assoc n (entget name))) ) ;Ham lap ds diem va doi tuong giao tai diem (defun rtoi( r) (fix (* 1000 (atof (rtos r 2 3)))) ) (defun prtoi( p) (list (rtoi (car p)) (rtoi (cadr p))) ) (defun C:BD_QLDT( / tg ss i name p10 p11 tg2 ls h) (setq tg (getvar "millisecs")) (setq ss (ssget "x" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE")))) (if ss (progn (setq i 0 L (sslength ss) m_bdqldt1 nil m_bdqldt2 nil) (while (< i L) (setq name (ssname ss i)) (setq ls (ACET-GEOM-OBJECT-END-POINTS name)) (setq p10 (car ls) p11 (cadr ls) p10 (prtoi p10) p11 (prtoi p11)) (setq m_bdqldt1 (append m_bdqldt1 (list (list name p10)))) (setq m_bdqldt2 (append m_bdqldt2 (list (list name p11)))) (setq i (1+ i)) ) )) (princ (/ (- (getvar "millisecs") tg) 1000.0)) (princ "s") (princ) ) ;Ham tim doi tuong tai diem bang bien dong (defun bd_ssdq (P / ls) (setq p (prtoi p) ls nil) (foreach a m_bdqldt1 (if (equal p (cadr a)) (setq ls (append ls (list (car a)))))) (foreach a m_bdqldt2 (if (equal p (cadr a)) (setq ls (append ls (list (car a)))))) ls ) (defun C:BD_SSDQ( / old p ls) (setq old (getvar "osmode")) (setvar "osmode" 1) (setq p (getpoint "\nPick") ls nil) (setvar "osmode" old) (if p (setq ls (bd_ssdq p))) (if ls (command "_.change" (acet-list-to-ss ls) "" "p" "c" 1 "") nil) ) ;Ham cn doi tuong sd bien dong (defun BD_CNDT ( ss / i L name p10 p11 ls dt) (setq i 0 L (sslength ss) dt nil) (while (< i L) (setq name (ssname ss i)) (setq ls (ACET-GEOM-OBJECT-END-POINTS name)) (setq p10 (car ls) p11 (cadr ls) p10 (prtoi p10) p11 (prtoi p11)) (if (setq dt (assoc name m_bdqldt1)) (setq m_bdqldt1 (subst (list name p10) dt m_bdqldt1))) (if (setq dt (assoc name m_bdqldt2)) (setq m_bdqldt2 (subst (list name p11) dt m_bdqldt2))) (if (null dt) (progn (setq m_bdqldt1 (append m_bdqldt1 (list (list name p10)))) (setq m_bdqldt2 (append m_bdqldt2 (list (list name p11)))) )) (setq i (1+ i)) ) ) (defun C:BD_CNDT( / ss) (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE")))) (if ss (bd_cndt ss)) ) (vl-load-com)
-
Để cho nhẹ, mình tập hợp và biên dịch các code ở trên thành file timduongbao.fas http://www.cadviet.com/upfiles/3/37170_timduongbao.rar cho nó gọn (tại vì trong file này mình viết lung tung kể cả những sưu tầm và đang thử nghiệm nên rất dài và rối, khi nào có code mới hoặc sau khi hoàn chỉnh mình sẽ lọc những hàm cần thiết rồi post lên). Nó có các hàm và lệnh sau :
- BD_QLDT : lệnh quản lý đối tượng line, arc, pline, spline ...
- BD_CNDT : lệnh cập nhật đối tượng khi bạn có thay đổi
- BD_SSDQ : lệnh trả về và tô đỏ tập ss tại điểm p (để kiểm tra hàm bd_ssqd)
- (defun bd_ssdq( p) ...) : hàm trả về tập ss (dạng list) tại điểm p
-
Hôm nay tiếp tục, các bạn nhìn hình trên. Mình dự định tìm đg bao theo hướng như sau :
1/ Đã tạo được ds quản lý đối tượng và điểm end của chúng.
- Đã có hàm quản lý đối tượng tại điểm end
- Đã có hàm trả vể các đối tượng giao tại một điểm.
- Đã có hàm cập nhật khi đối tượng thay đổi
Vấn đề tiếp theo là :
2/ Cung cấp một điểm, lập hàm tìm đc đối tượng gần nhất (giả sử cạnh 1-5)
3/ Từ đối tượng tìm đc trên (mục 2), nó có thể là (line, pline, arc, spline ...), theo chiều kim đồng hồ (qui ước vậy), căn cứ tập ss trả về tại cái điểm ở hướng tiến, ta phải tìm đối tượng tiếp theo tham gia vào cái đg đi. Ở đây, nếu là line thì đơn giản, arc còn có thể, nhưng spline thì hơi căng ... Mình chưa làm đc lệnh này.
4/ Giả sử hoàn thành (mục 3), đã tìm được đường đi và đã khép về điểm đầu (1-2-3-4-5), chuyển sang giai đoạn tính diện tích. Nếu toàn line thì quá dễ, TH có cả arc và spline thì làm thể nào. Mình cũng chưa làm được lệnh này.
Nhờ các bạn tham gia tư vấn, gợi ý cách làm lệnh tìm đg đi ở mục 3 và tình diện tích ở mục 4 với dữ liệu đã có ở mục 1 và 2. Cám ơn các bạn
-
Kg biết vđ này đã có ai đề cập chưa. Nếu có rồi bạn nào biết chỉ giúp
Mình muốn viết một hàm tựa như foreach, tức đối số là một hàm sẽ nhận trị do hàm gọi cung cấp;
VD : (defun aaa( bbb / a) (setq a 1) (bbb a))
trong đó bbb là bất cứ hàm nào, nó sẽ sd trị của biến a để làm việc gì đó. Cám ơn các bạn
-
Chờ các bác mãi kg thấy đâu (có lẽ đang mãi mê với mục "so sánh bv"), mình mày mò viết thêm một đoạn code cho nó làm nốt cái cv cắt đối tượng.
;Ham giao doi tuong cua 1 ban tren Cadviet (defun GiaoDT (ent1 ent2 / ob1 ob2 g kq sd) (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) ) ;Ham sx trich tren Cadviet (defun SXDStheocs( lis index) (vl-sort lis (function (lambda (e1 e2) (< (nth (- index 1) e1) (nth (- index 1) e2))))) ) (defun frac( real) (abs (- (abs real) (abs (fix real)))) ) ;PP chia ô cua bac Thai (defun select-c (p1 p2 n filter / ss) (if (setq ss (ssget "c" p1 p2 filter)) (if (< (sslength ss) (abs (setq n (* -1 n)))) (list (list p1 p2)) (if (< n 0) (append (select-c p1 (list (* 0.5 (+ (car p2) (car p1))) (cadr p2)) n filter) (select-c p2 (list (* 0.5 (+ (car p2) (car p1))) (cadr p1)) n filter)) (append (select-c p1 (list (car p2) (* 0.5 (+ (cadr p2) (cadr p1)))) n filter) (select-c p2 (list (car p1) (* 0.5 (+ (cadr p2) (cadr p1)))) n filter)))))) ; lay phan tu theo so hieu tu thuc the (defun diem( name n) (cdr (assoc n (entget name))) ) ;Ham lap ds diem va doi tuong giao tai diem (defun rtoi( r) (fix (* 1000 (atof (rtos r 2 3)))) ) (defun prtoi( p) (list (rtoi (car p)) (rtoi (cadr p))) ) ;Ham tim giao cua 2 doi tuong bang PP chia o, sau do dua vao ham lapdsgiao1 de lapds giao diem giao va doi tuong giao tai diem (defun lapdsdiemgiaovadtgiao( loai / tg i j Li Lj ss n1 n2 k lis lisgiao2dt n m tg) (defun breaktheodsdt1( ds / h name n1 p i ss L j Lj m tg1 tg2) (setq m 0) (setq tg1 (getvar "millisecs")) (foreach n ds (progn (setq m (1+ m)) (if (= (frac (/ m 1000.0)) 0.0) (progn (setq tg2 (getvar "millisecs")) (prompt (strcat "\nGiai doan cat doi tuoong: " (itoa m) " : ")) (princ (/ (- tg2 tg1) 1000.0)) (princ " giay.") (setq tg1 tg2) )) (setq h (car n) name (handent h) i 1 L (length n) ss nil ss (ssadd)) (ssadd name ss) (while (< i L) (setq p (nth i n) p (list (/ (car p) 1000.0) (/ (cadr p) 1000.0))) (setq j 0 Lj (sslength ss) kt nil) (while (and (null kt) (< j Lj)) (setq name (ssname ss j)) (setq p1 (vlax-curve-getClosestPointTo name p)) (if (<= (distance p p1) 0.002) (progn (cond ((and (= (diem name 0) "ELLIPSE") (= (diem name 41) 0.0)) (setq p1 (list (+ (car p) 0.001) (+ (cadr p) 0.001)))) ((or (= (diem name 0) "CIRCLE") (= (diem name 0) "SPLINE")) (setq p1 (list (+ (car p) 0.001) (+ (cadr p) 0.001)))) ((and (= (diem name 0) "LWPOLYLINE") (= (diem name 70) 1)) (setq p1 (list (+ (car p) 0.0001) (+ (cadr p) 0.0001)))) ((and (= (diem name 0) "POLYLINE") (= (diem name 70) 1)) (setq p1 (list (+ (car p) 0.0001) (+ (cadr p) 0.0001)))) (T (setq p1 p)) ) (setq n1 (entlast)) (command "_.break" name p p1) (setq name (entlast)) (if (null (equal n1 name)) (ssadd name ss)) (setq kt T) )) (setq j (1+ j)) ) (setq i (1+ i)) ) )) ) ;sd ham giao doi tuong de lap ds doi tuong giao va diem giao (defun lapdsgiaotheodt1( lisgiao2dt n1 n2 / p dl dl1 h1 h2) (foreach m lisgiao2dt (progn (setq p (prtoi m) h1 (diem n1 5) h2 (diem n2 5)) (setq dl (assoc h1 listggiaotheodt)) (if (null dl) (setq listggiaotheodt (append listggiaotheodt (list (list h1 p)))) (progn (setq dl1 nil) (if (null (member p dl)) (setq dl1 (append dl (list p)))) (if dl1 (setq listggiaotheodt (subst dl1 dl listggiaotheodt))) )) (setq dl (assoc h2 listggiaotheodt)) (if (null dl) (setq listggiaotheodt (append listggiaotheodt (list (list h2 p)))) (progn (setq dl1 nil) (if (null (member p dl)) (setq dl1 (append dl (list p)))) (if dl1 (setq listggiaotheodt (subst dl1 dl listggiaotheodt))) )) )) ) ;;;;;;;;;;;;;;;;;;; (setq tg (getvar "millisecs") m 0 tg1 tg) (if (setq ss (ssget "x" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (progn (setq box (ACET-GEOM-SS-EXTENTS-FAST ss) p1 (car box) p2 (cadr box)) (setq lis (select-c p1 p2 50 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (setq i 0 Li (length lis) listggiaotheop nil listggiaotheodt nil) (while (< i Li) (setq box (nth i lis) p1 (car box) p2 (cadr box)) (setq ss (ssget "c" p1 p2 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (setq j 0 Lj (sslength ss)) (while (< j Lj) (setq n1 (ssname ss j)) (setq k (+ j 1)) (while (< k Lj) (setq n2 (ssname ss k)) (setq lisgiao2dt (Giaodt n1 n2)) (cond ((= loai 4) (if lisgiao2dt (lapdsgiaotheodt1 lisgiao2dt n1 n2))) ) (setq k (1+ k)) (setq m (1+ m)) (if (= (frac (/ m 10000.0)) 0.0) (prompt (strcat "\nGiai doan tim giao: " (itoa m)))) ) (setq j (1+ j)) ) (setq i (1+ i)) ) )) (setvar "osmode" 0) (setvar "cmdecho" 0) (print (strcat "\nCo " (itoa (length listggiaotheodt)) " diem giao")) (if (and (= loai 4) listggiaotheodt) (breaktheodsdt1 listggiaotheodt)) (princ (/ (- (getvar "millisecs") tg) 1000.0)) (princ " giay.") ) (defun c:vdtg4() (command "undo" "be") (lapdsdiemgiaovadtgiao 4) (command "undo" "e") ) (vl-load-com)Lệnh là vdtg4. Nói chung giai đoạn tìm giao đã chạy ổn và khá nhanh, nhưng gđ cắt đối tượng mình chưa yên tâm lắm.
- Một là : PP cắt như thế có ổn kg
- Hai là : Kg hiểu sao thời gian ngày càng chậm (code trong hàm breaktheodsdt1)
Nhờ các bạn xem và tư vấn giúp 2 vđ trên.
Mình đưa bv đủ thứ đt để các bạn thử. Có thể xóa bốt đi nếu cần.
http://www.cadviet.c...oituong2070.dwg
Xin cám ơn
-
Oh, Send luôn vào email rồi nhé.
Cái này thì lôi project của tớ ra đi. trong đó lệnh HN bao gồm luôn chức năng duyệt Trắc dọc - Trắc ngang - Bình đồ đồng thời rồi đó thôi. hướng dẫn sử dụng tớ viết kèm luôn trong mail ấy.
Bác Thai có thể gởi cho mình một bản, biết đâu may mắn mình có thể chuyển qua arx. mail của mình là trungngamy@yahoo.com. Cám ơn bác
-
Mình không rõ Detailing đang nói về ngôn ngữ khác hay về lisp. nhưng nếu đang nói về lisp thì nhận định này sai rồi. từ bản vẽ hiện hành ta có thể can thiệp vào các bản vẽ khác đang mở mà hoàn toàn ko cần active nó. Trong code mình gửi cho bạn mình cũng thực hiện việc này thông qua đoạn code:
(vlax-for dwg (vla-get-documents (vlax-get-acad-object)) (vla-setvariable dwg "users1" ""))
Mặt khác, khi xem xét cấu trúc của 1 vla-object thì mình nhận thấy rằng bản thân nó đã quy định cho đối tượng thuộc document (file bản vẽ) nào. bạn có thể lấy ra document đang lưu giữ 1 đối tượng bằng hàm (vla-get-document vla-object). Việc chỉnh sửa 1 đối tượng thuộc bản vẽ không hiện hành thực hiện hoàn toàn bình thường y hệt như bạn thao tác trên bản vẽ hiện hành.
Có nhiều ý kiến cho rằng cad chỉ làm việc với active document. nhưng mình nghĩ là không fải như vậy. Bởi đối tượng vla gốc là chính chương trình cad đang mở cơ mà (vlax-get-acad-object)
Lisp thì là vậy. vba chắc chắn cũng tương tự. .Net thì mình chưa biết
Trong arx cũng có cái này, nó ở ví dụ mẫu : ...ObjectARX 2010\samples\database\testdb_dg
-
Trong khi chờ các bạn giúp đỡ mình đã viết hàm "break" đối tượng dựa vào danh sách quản lý đối tượng và các tọa độ tại điểm cần "break". Hàm này mình thấy chỉ sd tót cho TH đối tượng hở (như đoạn thẳng, pline hở, spline hỏ, cung, tròn, cung elip), còn các TH kín như HCN, đg tròn, elip hoặc pl, spl đóng thì chưa chạy đc. Phiền các bạn tư vấn cho. Sau đây là code :
(defun breaktheodsdt( ds / h name p i ss L j Lj m) (setq m 0) (foreach n ds (progn (setq h (car n) name (handent h) i 1 L (length n) ss (ssadd)) (ssadd name ss) (while (< i L) (setq p (nth i n) p (list (/ (car p) 1000.0) (/ (cadr p) 1000.0))) (setq j 0 Lj (sslength ss) kt nil) (while (and (null kt) (< j Lj)) (setq name (ssname ss j)) (setq p1 (vlax-curve-getClosestPointTo name p)) ; (print (list name p1 p)) (if (<= (distance p p1) 0.002) (progn (command "_.break" name p p) (setq name (entlast)) (ssadd name ss) (setq kt T Lj (sslength ss)) (print (setq m (1+ m))) )) (setq j (1+ j)) ) (setq i (1+ i)) ) )) ) -
Hình như bác có nhầm lẫn gì đó ở đây. trong code đó em có hàm kiểm tra điều kiện tập chọn có đối tượng ngay từ đầu rồi mà
(defun select-c (p1 p2 n filter / ss)
(if (setq ss (ssget "c" p1 p2 filter))
(thân hàm)
))
rõ ràng nếu ss = nil thì hàm kết thúc luôn chứ không có nhảy vào thân hàm để lặp tiếp.
Có lẽ mình diễn tả kg rõ, ý mình muốn nói là làm thế nào cho hàm này kg bị "treo" khi mình chọn số đối lượng trong 1 ô khá nhỏ như TH đã gặp. Có thể dùng biện pháp nào đó để khắc phục. Vì việc chọn số đối tượng lớn thì an toàn hơn (tuy nhiên cũng chưa chắc là tuyệt đối trong mọi TH) nhưng nó chạy chậm hơn. Phiền bác giúp cho. Cám ơn bác
-
Để đơn giản, trước hết ta xét các đối tượng giao nhau tại 2 đầu của chúng và kg có đối tượng bên trong. Sau khi chạy tốt sẽ xét TH các đối tượng giao nhau bất kỳ và có đối tượng kín bên trong. Như vậy sẽ phát sinh việc "cắt đối tượng" . Việc cắt đối tượng đã có Lisp "BreakObjects.lsp" của Charles Alan Butler. Tuy nhiên, Lisp này chạy lâu quá nên mình viết một Lisp khác làm công việc này. Code như sau :
;--------------------------------------------------------------------------------------------------------- ;PP chia ô cua bac Thai (defun select-c (p1 p2 n filter / ss) (if (setq ss (ssget "c" p1 p2 filter)) (if (< (sslength ss) (abs (setq n (* -1 n)))) (list (list p1 p2)) (if (< n 0) (append (select-c p1 (list (* 0.5 (+ (car p2) (car p1))) (cadr p2)) n filter) (select-c p2 (list (* 0.5 (+ (car p2) (car p1))) (cadr p1)) n filter)) (append (select-c p1 (list (car p2) (* 0.5 (+ (cadr p2) (cadr p1)))) n filter) (select-c p2 (list (car p1) (* 0.5 (+ (cadr p2) (cadr p1)))) n filter)))))) ; lay phan tu theo so hieu tu thuc the (defun diem( name n) (cdr (assoc n (entget name))) ) ;Ham lap ds diem va doi tuong giao tai diem (defun rtoi( r) (fix (* 1000 (atof (rtos r 2 3)))) ) (defun prtoi( p) (list (rtoi (car p)) (rtoi (cadr p))) ) ;Ham giao d?i tu?ng c?a cadviet (defun GiaoDT (ent1 ent2 / ob1 ob2 g kq sd) (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) ) ;------------------------------------------------------------------------------------------------------ ;Ham tim giao cua 2 doi tuong bang PP chia o, sau do dua vao ham lapdsgiao1 de lapds giao diem giao va doi tuong giao tai diem (defun lapdsdiemgiaovadtgiao( / tg i j Li Lj ss n1 n2 k lis lisgiao2dt n m) ;sd lenh trim de cat doi tuong theo ds doi tuong va diem giao (defun breaktheodsdt( ds / h name p i ss L j Lj m) (setq m 0) (foreach n ds (progn (setq h (car n) name (handent h) i 1 L (length n) ss (ssadd)) (ssadd name ss) (while (< i L) (setq p (nth i n) p (list (/ (car p) 1000.0) (/ (cadr p) 1000.0))) (setq j 0 Lj (sslength ss) kt nil) (while (and (null kt) (< j Lj)) (setq name (ssname ss j)) (setq p1 (vlax-curve-getClosestPointTo name p)) ; (print (list name p1 p)) (if (<= (distance p p1) 0.002) (progn (command "_.break" name p p) (setq name (entlast)) (ssadd name ss) (setq kt T Lj (sslength ss)) (print (setq m (1+ m))) )) (setq j (1+ j)) ) (setq i (1+ i)) ) )) ) ;sd ham giao doi tuong de lap ds doi tuong giao va diem giao (defun lapdsgiaotheodt( lisgiao2dt n1 n2 / p dl dl1 h1 h2) (foreach m lisgiao2dt (progn (setq p (prtoi m) h1 (diem n1 5) h2 (diem n2 5)) (setq dl (assoc h1 listggiaotheodt)) (if (null dl) (setq listggiaotheodt (append listggiaotheodt (list (list h1 p)))) (progn (setq dl1 nil) (if (null (member p dl)) (setq dl1 (append dl (list p)))) (if dl1 (setq listggiaotheodt (subst dl1 dl listggiaotheodt))) )) (setq dl (assoc h2 listggiaotheodt)) (if (null dl) (setq listggiaotheodt (append listggiaotheodt (list (list h2 p)))) (progn (setq dl1 nil) (if (null (member p dl)) (setq dl1 (append dl (list p)))) (if dl1 (setq listggiaotheodt (subst dl1 dl listggiaotheodt))) )) )) ) ;sd ham giao doi tuong de lap ds diem giao va doi tuong giao (defun lapdsgiaotheop( lisgiao2dt n1 n2 / p dl dl1) (foreach m lisgiao2dt (progn (setq p (prtoi m)) (setq dl (assoc p listggiaotheop)) (if (null dl) (setq listggiaotheop (append listggiaotheop (list (list p (diem n1 5) (diem n2 5))))) (progn (setq dl1 nil) (if (null (member (diem n1 5) dl)) (setq dl1 (append dl (list (diem n1 5))))) (if (null (member (diem n2 5) dl)) (setq dl1 (append dl (list (diem n2 5))))) (if dl1 (setq listggiaotheop (subst dl1 dl listggiaotheop))) )) )) ) (setq tg (getvar "millisecs") m 0) (if (setq ss (ssget "x" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (progn (setq box (ACET-GEOM-SS-EXTENTS-FAST ss) p1 (car box) p2 (cadr box)) (setq lis (select-c p1 p2 50 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (setq i 0 Li (length lis) listggiaotheop nil listggiaotheodt nil) (while (< i Li) (setq box (nth i lis) p1 (car box) p2 (cadr box)) (setq ss (ssget "c" p1 p2 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (setq j 0 Lj (sslength ss)) (while (< j Lj) (setq n1 (ssname ss j)) (setq k (+ j 1)) (while (< k Lj) (setq n2 (ssname ss k)) (setq lisgiao2dt (Giaodt n1 n2)) ; (if lisgiao2dt (lapdsgiaotheop lisgiao2dt n1 n2)) (if lisgiao2dt (lapdsgiaotheodt lisgiao2dt n1 n2)) (setq k (1+ k)) (print (setq m (1+ m))) ) (setq j (1+ j)) ) (setq i (1+ i)) ) )) (setvar "osmode" 0) (setvar "cmdecho" 0) (if listggiaotheodt (breaktheodsdt listggiaotheodt)) (print (strcat "\nCo " (itoa (length listggiaotheodt)) " diem giao")) (princ (/ (- (getvar "millisecs") tg) 1000.0)) (princ " giay.") ) (defun c:vdtg() (lapdsdiemgiaovadtgiao) )So với BreakObjects.lsp, Lisp này chạy nhanh gấp 50 lần với khoảng 200 đối tượng (bao gồm line, pline, spline, arc ...) và 200 điểm giao (tức khoảng 18s so với 900s). Khi số đối tượng càng tăng thì tốc độ càng thấy rõ hơn. Tuy nhiên, mình chỉ viết để phục vụ việc tìm đường bao và cũng kg đủ kiến thức nên kg viết đầy đủ như BreakObjects.lsp. Mặt khác, khi viết lisp này, mình chưa hội đủ đk tốt nhất để viết hàm break mà sd hàm break của cad (mình đang nhờ các bạn giúp trên mục Thuật toán, ý tưởng). Có thể đây là điểm yếu của Lisp này (mình chỉ viết tạm để các bạn dễ tư vấn, mình chỉ viết TH các đối tượng là hở, các đối tượng kín như đường tròn, elip ... mình chưa viết đc). Nhờ các bạn xem qua và tư vấn, chỗ có lệnh "break". Cám ơn các bạn
-
Mình có tham khảo cái lisp cắt đối tượng (BreakObjects.lsp) của Charles Alan Butler. Lisp rất hay khổ cái nó chạy quá chậm nên dự định viết lại một ít để cải thiện tốc độ. Cũng vì cải thiện tốc độ nên mình phải tham khảo ý kiến các bạn.
Giả sử mình có một đối tượng (LINE, LWPOLYLINE, ARC, ELIP, SPLINE ...) và một danh sách các điểm giao (kg có thứ tự), làm thế nào để cắt chúng ra thật nhanh.
Minh giải thích thêm : Mình viết một giải thuật tìm những điểm giao có thể có trên 1 đối tượng, sau đó đem chúng ra cắt.
Một đối tượng tương ứng với một danh sách, giữa các đối tượng kg liên quan gì với nhau nữa, chỉ làm sao cắt từng thằng thật nhanh, chậm chậm thì mình làm cũng đc. Hình minh họa :
Kg biết bạn nào có thể giải thích cách cắt đối tượng của lisp trên (chỉ lúc nó đem đối tượng ra cắt thôi), mình xem qua chẳng hiểu gí cả
Cám ơn các bạn.
-
Cám ơn bác Doan Van Ha đã hỗ trợ nhưng bác cần kết hợp với PP chia ô của bác Thái. Nếu kg có những giải pháp rút ngắn thời gian thì kg thể đặt vđ này đc. Hiện code của bác chạy trên bv khoảng 1000 line (chưa nói đến các đối tượng khác như đg tròn, elip ...) mất khoảng 80''. Mình nghĩ nếu bác kết hợp PP chia ô sẽ mất dưới 5''. Nếu bác bận để mình cố gắng lồng PP chia ô vào nhưng hơi lâu, tại mình kg quen các hàm vl lắm. Mình nghĩ ngoài PP chia ô còn phải sd PP phân mảnh biến nữa, nó tương tự như biến động
Hôm rồi chạy thử code của bác Ha mất 80'', thực ra chỉ mất 35'', kg biết máy mình nó bị gì, hôm nay nó chạy nhanh hơn. Tuy nhiên, như vậy vẫn là quá chậm so với công việc. Mình đã kết hợp PP chia ô và code của 1 bạn trên DD chế biến lại, cũng trên bv đó mất chỉ 2''. Mình đưa lên để các bạn tham khảo, nếu bác nào có thể cải tiến nhanh hơn thì xin giúp cho.
(defun select-c (p1 p2 n filter / ss) (if (setq ss (ssget "c" p1 p2 filter)) (if (< (sslength ss) (abs (setq n (* -1 n)))) (list (list p1 p2)) (if (< n 0) (append (select-c p1 (list (* 0.5 (+ (car p2) (car p1))) (cadr p2)) n filter) (select-c p2 (list (* 0.5 (+ (car p2) (car p1))) (cadr p1)) n filter)) (append (select-c p1 (list (car p2) (* 0.5 (+ (cadr p2) (cadr p1)))) n filter) (select-c p2 (list (car p1) (* 0.5 (+ (cadr p2) (cadr p1)))) n filter)))))) ; lay phan tu theo so hieu tu thuc the (defun diem( name n) (cdr (assoc n (entget name))) ) ;Ham lap ds diem va doi tuong giao tai diem (defun rtoi( r) (fix (* 1000 (atof (rtos r 2 3)))) ) (defun prtoi( p) (list (rtoi (car p)) (rtoi (cadr p))) ) ;--------------------------------------------------------------------------------------------------------- (defun GiaoDT (ent1 ent2 / ob1 ob2 g kq sd) (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) ) ;tim giao tong hop (defun timgiaodoituongbatky( / tg i j Li Lj ss n1 n2 k lis lisgjk n) (defun lapdsgiao1( lisgiao n1 n2 / p dl dl1) (foreach m lisgiao (progn (setq p (prtoi m)) (setq dl (assoc p listggiao)) (if (null dl) (setq listggiao (append listggiao (list (list p (diem n1 5) (diem n2 5))))) (progn (setq dl1 nil) (if (null (member (diem n1 5) dl)) (setq dl1 (append dl (list (diem n1 5))))) (if (null (member (diem n2 5) dl)) (setq dl1 (append dl (list (diem n2 5))))) (if dl1 (setq listggiao (subst dl1 dl listggiao))) )) )) ) (setq tg (getvar "millisecs")) (if (setq ss (ssget "x" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (progn (setq box (ACET-GEOM-SS-EXTENTS-FAST ss) p1 (car box) p2 (cadr box)) (setq lis (select-c p1 p2 50 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) ; (print (strcat "\nDuoc chia thanh " (itoa (length ltd_lis)) " hinh")) (setq i 0 Li (length lis) listggiao nil) (while (< i Li) (setq box (nth i lis) p1 (car box) p2 (cadr box)) (setq ss (ssget "c" p1 p2 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (setq j 0 Lj (sslength ss)) (while (< j Lj) (setq n1 (ssname ss j)) (setq k (+ j 1)) (while (< k Lj) (setq n2 (ssname ss k)) (setq lisgjk (Giaodt n1 n2)) (if lisgjk (lapdsgiao1 lisgjk n1 n2)) (setq k (1+ k)) ) (setq j (1+ j)) ) (setq i (1+ i)) ) )) (print (strcat "\nCo " (itoa (length listggiao)) " diem giao")) (princ (/ (- (getvar "millisecs") tg) 1000.0)) (princ " giay.") ) (defun c:vdtg() (timgiaodoituongbatky) ) ;---------------------------------------------------------------------------------------------------------Phần tiếp theo của chủ đề này mình sẽ post trong nay mai, mong các bác tiếp sức
-
Trong nội dung trả lời #14 em chạy đoạn đầu của lisp: chay thấy ok. nó đã lưu ra 1 file do mình đặt tên là hoanchinh.txt (tức là file số liệu thô đã được chuyển thành các trạm máy, điểm mia ra góc và cạnh). đúng ra chương trình sẽ tiếp tục chạy và phun điểm mia ra màn hình nếu như file số liệu hoanchinh.txt nó được khai báo các trạm máy lên trên hoặc ít nhất 2 trạm máy thì nó sẽ phun điểm mia ra màn hình rồi. Nó sẽ phải có file số liệu hoanchinh.txt như sau:
TR A 1000.0000 1000.0000 (TR A và TR B phải khai báo ở trên đây nó mới hiểu và chạy)
TR B 1013.225 1000.000 (TR A và TR B có thể cho tọa độ giả định cũng được và nó mặc định luôn 2 trạm máy này ở trên đây khi lưu file hoanchinh.txt của các xử lý đo khác!)
TR A
DH B 359.5958 13.225
1 159.2151 12.830
2 173.3153 10.333
3 176.1120 7.545
4 160.0905 8.767
5 161.2952 6.784
6 287.2502 1.664
7 92.3453 1.446
8 9.0236 8.322
9 356.0835 8.282
10 348.2042 7.823
11 353.2437 13.805
12 267.2044 8.623
13 268.1017 12.724
14 263.1002 17.713
TR B
DH A 0.0000 13.225
15 57.1949 10.382
16 64.2908 14.114
17 79.5016 20.308
18 123.4920 7.380
19 139.5210 7.830
.................................
các anh có thể sửa giúp em trong cái lisp chế biến (CB) nó mặc định luôn dòng:
TR A 1000.0000 1000.0000
TR B 1200.0000 1000.0000
sau đó nó sẽ nối tiếp là các số liệu đo lưu bình thường là
TR A
DH B 359.5958 13.225
1 159.2151 12.830
2 173.3153 10.333
3 176.1120 7.545
4 160.0905 8.767
...............................
vậy coi như là số liệu đã ổn và phun ra màn hình!
Thế bạn có hiểu đc số liệu ở đây nó nói cái gì kg. Có nhiều cách để xử lý số liệu đo đạc và nhiều chương trình làm việc này với nhiều định dạng khác nhau. Nếu chưa hiểu, tốt nhất bạn nên làm việc với một người có kinh nghiệm và cố gắng học hỏi để tránh những sai lầm có thể xảy ra, Nếu hiểu rồi bạn có thể tìm những chương trình miễn phí phục vụ công việc này trên trang tracdiaviet.com và tracdiacongtrinh.com sau đó ứng dụng cho phù hợp với công việc của bạn.
Nếu chưa tìm đc chương trình tốt hơn hoặc bạn có thể tham khảo một đoạn CT ở đây để làm tạm (trang #14) :
http://www.cadviet.com/forum/index.php?showtopic=64807
Bạn cũng có thể sd chương trình sau để bình sai và xử lý số liệu trong khi chưa tìm đc chương trình tốt hơn (rất nhiều trên mạng) : http://www.cadviet.com/upfiles/3/37170_binhsai.rar
Để sd bạn phải có kiến thức tối thiểu về trắc địa mặc dù nó dể sd
Ghi chú : Bạn hãy đổi tên file ltd.e thành ltd.exe để chạy
-
1
-
-
Em nghĩ nếu có cái này có thể sử dụng vào việc vẽ mặt bằng các tầng trong khi theo dõi mặt bằng tầng 1 (nếu thao tác được cả các lệnh khác một cách bình thường), nhất là trong lĩnh vực quy hoạch, có thể theo dõi các bản vẽ trên nền hiện trạng khu đất và ngược lại...
Nói chung là đại tiện :D
Mời các cao thủ xuống núi, các bác bổ xung ý tưởng cho hoàn chỉnh. Xin cảm ơn.
Mình thấy cái này chỉ cần đưa tọa độ và tỷ lệ các bv trùng nhau, đổi màu cho nó khác tý sau đó insert hay xref là có thể tham khảo đc rồi. Chính xác đến từng cm Tại sao phải rắc rối vậy
-
Vấn đề này mình vướng mắc cũng khá lâu rồi nhưng chưa có cách nào giải quyết được, hôm nay đành post lên đây mong các bác cùng thảo luận giải quyết vấn đề này giúp mình.
Nó ngắn gọn thế này thôi: Mình muốn lưu vào dữ liệu của 1 bản vẽ 1 đoạn code lisp, và khi đem bản vẽ đó mở ở bất kì máy nào, với bất kỳ đời cad nào có thể mở bản vẽ đó từ 2004 trở lên (thấp hơn nữa thì càng tốt) thì đoạn code lưu trong bản vẽ đó tự động được tải.
nôm na thì nó giống i xì như cách thức mà con virus Acad.lsp đã làm, nhưng mình không muốn bất kì file nào được tạo ra cùng bản vẽ. tất nhiên là không phải mình định viết 1 em virus phá anh em đâu nhé ^^
Mình tin chắc các bác cũng nhận thấy được rằng nếu thực hiện được công việc này thì ứng dụng của nó là rất lớn. Hiện tại thì mình mới chỉ giải quyết được 1/2 công việc, đó là lưu đoạn code đó vào Xrecord hoặc vào 1 trong các biến hệ thống Users# dưới dạng 1 chuỗi.
1/2 vấn đề khó khăn còn lại là mình không làm sao để cad có thể tự động đọc và tải đoạn code đó vào bản vẽ khi mở bản vẽ.
Trên đây là hướng đi của mình và đang gặp ngõ cụt. Nếu các bác có cách nào thông cái ngõ này ra hoặc có đường khác để đi xin hãy mách nước cho mình. Mình mong muốn có thể giải quyết vấn đề này thuần lisp vì mình chỉ biết mỗi lisp và mình áp dụng cái này cho 1 vài chương trình mình viết bằng lisp, nhưng nếu không thể thì bằng các ngôn ngữ khác cũng được. Cảm ơn các bác trước :D
Muốn vậy, bạn phải cài một con "virus" vào máy bạn muốn thực thi công việc đó. Ví dụ : bạn đã lưu đoạn mã sau vào bản vẽ
(defun c:aaa() (setq a 1) (print a))
sau đó, khi mở file, bạn đọc lại nó, nó sẽ được lưu trong một st, tương tự như bạn làm công việc sau (việc này bạn cài vào file virus của bạn) :
(setq st "(defun c:aaa() (setq a 1) (print a))")
tiếp theo, cũng trong file virus, bạn thực hiện : (eval (read st))
bạn sẽ có hàm c:aaa. Để thực hiện, trong file virus bạn gọi (c:aaa)
Việc này tuy kg ghi code của bạn ra file nhưng phải có đoạn code thực thi trong file virus, còn nếu kg có cả file virus thì mình cũng chịu
Chúc bạn thành công
-
Kể ra thì cũng vất vả khi phải giải bài toán của bác Trung_Nga_Mỹ(???).
Tôi không có bản vẽ lớn để kiểm tra nhiều, do đó bác test xem sao nhé, nhất là khoản tốc độ.
Lisp: tạo danh sách các giao điểm của tập hợp chọn, kèm Handle của các đối tượng giao tương ứng tại từng điểm.
;Doan Van Ha - CADViet.com - Ngay 04/7/2012 ;Muc dich: List c¸c giao ®iÓm cña Set, kÌm Handle cña c¸c ®èi tîng giao t¬ng øng t¹i tõng ®iÓm. (defun C:HA() (setq ss (ssget)) (HA:LstInterSet ss)) ;----- (defun HA:LstInterSet (ss / obj1 obj2 i j lst) (setq i (sslength ss)) (while (>= (setq j (1- i) i (1- i)) 0) (setq obj1 (vlax-ename->vla-object (ssname ss i))) (while (>= (setq j (1- j)) 0) (setq obj2 (vlax-ename->vla-object (ssname ss j)) lst (cons (HA:LstInter2Obj obj1 obj2) lst)))) (setq lst (apply 'append lst)) (foreach x (setq z lst) (foreach y (setq z (cdr z)) (if (equal (car x) (car y) 1E-8) (progn (setq lst (subst (LM:Unique (append x (cdr y))) x lst)) (setq x (LM:Unique (append x (cdr y)))) (setq lst (vl-remove y lst)))))) lst) ;----- List c¸c giao ®iÓm cña 2 Objs. (defun HA:LstInter2Obj (obj1 obj2 / lst1 lst2 h1 h2) (setq h1 (vla-get-handle obj1) h2 (vla-get-handle obj2)) (setq lst1 (vlax-invoke obj1 'IntersectWith obj2 acExtendNone)) (while lst1 (setq lst2 (cons (list (list (car lst1) (cadr lst1) (caddr lst1)) h1 h2) lst2)) (setq lst1 (cdddr lst1))) (reverse lst2)) ;----- List gåm c¸c phÇn tö kh¸c nhau. (defun LM:Unique (l) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))Cám ơn bác Doan Van Ha đã hỗ trợ nhưng bác cần kết hợp với PP chia ô của bác Thái. Nếu kg có những giải pháp rút ngắn thời gian thì kg thể đặt vđ này đc. Hiện code của bác chạy trên bv khoảng 1000 line (chưa nói đến các đối tượng khác như đg tròn, elip ...) mất khoảng 80''. Mình nghĩ nếu bác kết hợp PP chia ô sẽ mất dưới 5''. Nếu bác bận để mình cố gắng lồng PP chia ô vào nhưng hơi lâu, tại mình kg quen các hàm vl lắm. Mình nghĩ ngoài PP chia ô còn phải sd PP phân mảnh biến nữa, nó tương tự như biến động
-
Mình dự định Viết lệnh này chung chủ để "Phân nhỏ tập hợp chọn bằng cách chia ô" vì nó sẽ sd kiến thức ở đây
nhưng theo ý kiến của bác Thai thì nên lập riêng. Thì mình theo các bạn vậy, cùng nhau lập ra lệnh này.
Tại sao lại viết lại lệnh này khi Cad đã có. Vì những lý do sau :
- Lệnh Cad chạy kg được những TH phức tạp
- Thông tin trả về chưa đầy đủ.
Phần lớn các bạn đều biết lệnh boundary của Cad chỉ tính tốt trong TH các đối tượng tương đối thoáng, còn lại thường báo lỗi. Đã có nhiều lần một số cao thủ muốn viết lại lệnh này nhưng chưa đủ kiên trì. Hôm nay mình muốn nhờ các bạn hỗ trợ hết mình để viết lại lệnh này, thậm chí nó sẽ có thể chạy tốt hơn và nhanh hơn Cad, thông tin đưa về cũng nhiều hơn. Mình sẽ đưa ra một số yêu cầu tương đối khó, mong tìm đc những đoạn code tốt nhất để ráp lại thành một lệnh hoàn chỉnh. Để viết đc lệnh trên cần rất nhiều thứ. Nếu đưa ra nhiều yêu cầu một lúc sẽ làm rối vđ và các bạn cũng ngán. Trước hết mình nhờ các bạn giúp :
- Lập danh sách quản lý tọa độ điểm giao và các đối tượng giao tại điểm này (lưu trong biến toàn cục). Mục đích để truy xuất các đối tượng giao nhau tại một điểm bất kỳ khi cung cấp tọa độ của nó.
Đây là hàm rất quan trọng nên rất cần sự chuẩn xác và tốc độ. Mong các cao thủ ra tay.
Theo mình thì có thể lưu danh sách tọa độ và đối tượng như sau : lis=((p1 h1 h2 h3) (p2 h1 h4 h5) ...) (trong đó pi là tọa độ, hi : mã dxf=5 của đt)
Khi dùng hàm truy xuất có dạng AAA( p lis) (assoc p lis)). Khi gọi (AAA p) -> (p h1 h2 h3)
Đó là suy nghĩ của mình. Còn cách nào hay hơn tùy các bạn.
Thực ra lệnh này trước đây mình đã viết bằng lisp và arx, tuy nhiên mình chỉ đủ sức viết với dữ liệu line và cũng chưa thật tốt, nhưng mình hoàn toàn làm chủ đc nó. Hôm nay có Cadviet hỗ trợ hy vọng sẽ cùng nhau viết đc một lệnh chạy trên nhiều loại đối tượng như lệnh của Cad nhưng mức độ sâu hơn và hoàn chỉnh hơn. Cám ơn các bạn trước.
[Thảo luận] Điều khiển AutoCAD bằng VC++ (ObjectARX)
trong Lập trình khác
Đã đăng · Trả lời báo cáo
Chào Detailing và các bạn.
Mình thử kiếm trong Arx một số hàm tương tự như trong Lisp (acet-, vl, vla ...)
VD : ACET-SS-TO-LIST, ACET-GEOM-OBJECT-END-POINTS,vlax-curve-getClosestPointTo , ...
nhưng kg thấy đâu cả. Kg biết nó có hay kg và tham khảo ở đâu. Mong đc các bạn chỉ dẫn.