Chuyển đến nội dung
Diễn đàn CADViet

elleHCSC

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    119

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    3

Bài đăng được đăng bởi elleHCSC

  1. Đã đăng · Trả lời báo cáo

    dwl = drawing locked

    file dwl được Acad sinh ra khi bạn open một file dwg (hơi khác 1 chút khi file *.bak được tạo ra khi bạn có 1 thay đổi nào đó trong file dwg). Tác dụng của file bak thì bạn biết rồi, còn tác dụng của file dwl là trong quá trình làm việc với dwg nếu như acad bị đơ không rõ lý do thì cái file dwl kia sẽ không tự biến mất (chỉ biến mất khi file dwg đã được close ngon lành) và nó sẽ báo cad khoá (báo lỗi cho user) file dwg lại cho đến khi user xem xét lại file dwg có vấn đề gì không.

    Với phiên bản cad đời cao tôi không rõ nhưng với các bản cad đời cũ hơn VD cad12 chẳng hạn thì khi bạn mở dwg và thoát khỏi cad mà có cái file dwl kia VD file a.dwg thì có 1 file là a.dwl thì lần làm việc sau bạn không mở được file a.dwg đâu, cad sẽ báo lỗi file. cách khắc phục khi mở 1 file dwg mà cad báo lỗi thì bạn xem trong cùng thư mục có file dwl nào không thì chỉ việc xoá đi là dwg kia cad sẽ open bình thường và không báo lỗi.

    • Vote tăng 2

  2. Đã đăng · Trả lời báo cáo

    Tớ chỉ có giải thuật chung nhất này (dùng cho Line) bạn xem có áp dụng được không :

     

    (defun IsPointOnLeftSide (p00 p01 p02 / Px Py x1 y1 x2 y2 dx dy xx yy ss1 ss2 trai) ; p00 la diem can xac dinh
 (setq
    Px (car p00)
    Py (cadr p00)
    x1 (car p01)
    y1 (cadr p01)
    x2 (car p02)
    y2 (cadr p02)
    dx (- x2 x1)
    dy (- y2 y1)
    xx (- Px x1)
    yy (- Py y1)
    ss1 (* dx yy)
    ss2 (* dy xx)
 )  
 (if (> ss1 ss2)
   (setq Trai 1) ; =1 true
   (setq Trai 0)
 )  
);

    • Vote tăng 1

  3. Đã đăng · Trả lời báo cáo

    Chào các bác trên diễn đàn !

    Em có một trường hợp như sau rất mong được các bác giúp đỡ

    em có rất nhiều thửa đất, có một đường Plyline cắt ngang qua một số thửa đất như hình vẽ

     

    http://www.cadviet.com/upfiles/3/vd_1.jpg

     

    rất mong được các bác giúp đỡ em làm sao có thể đánh được :

    - ĐÁNH SỐ THỬA

    - TÍNH DIỆN TÍCH TRONG VÀO NGOÀI ĐƯỜNG GIỚI HẠN

    - XUẤT SANG EXCELL bảng thống kê

    Rất mong được các bác trên diện đàn anh em trắc địa bọn em đỡ vất vả, món Lisp này em chẳng biết gì

     

    Cho em được cảm ơn các bác trước vậy

     

    Đây là file em gửi kèm của em

     

    http://www.cadviet.com/upfiles/3/vd_10_1.rar

     

    * Viết bằng lisp để thoả mãn cả mấy cái yêu cầu của này của bạn là khá vất vả đó, còn nếu bạn sử dụng CADMAP thì có thể cũng làm được chí ít 3 mục tiêu:

    - Tính diện tích thửa đất tổng (cái này dễ rồi vì đã có lisp trên CV hoặc dùng CADMAP)

    - Đánh số thửa (cũng dễ trên CV cũng đã có lisp rồi)

     

    mục tiêu thứ 3 : tính diện tích trong ngoài đường giới hạn của chỉ giới: bạn dùng CADMAP và nghiên cứu kỹ (mò mẫn đi) 2 mục của Map\Topology\ để tạo topo + closed_polylines và Map\query để "truy vấn" topo và xuất kết quả ra bản vẽ (chứ ko phải ra excel nhé), kết quả chạy cũng rất nhanh và chính xác đối với 1 tờ BĐ_ĐC hoặc cả bvẽ 1 tuyến đường dài. Trước CQ tôi có người ở XN làm rất thuần thục các công việc này, giờ ko còn làm công việc đó chắc "thất truyền" roài.

     

    th1.png

     

    th2.png

    Công việc bận quá chứ có thời gian tôi ngồi làm cho bạn 1 tutor về cái cắt thửa rồi topo để tính diện tích trong ngoài cũng như xuất kết quả ra màn hình.

     

    mục tiêu cuối : xuất bảng thống kê sang excel thì chắc phải lisp rồi, bạn kiếm trên CV xem có không chứ Modz theo từng y/c cụ thể thì tôi nghĩ là chưa có.

  4. Đã đăng · Trả lời báo cáo

    Nhưng cái hộp thoại bắt phải gõ tiếng việt nó cứ nhảy liên tục ra màn hình mỗi khi gõ 1 ký tự khó chịu quá anh Hoành ơi, tôi cứ phải post lần 1 lên rồi chọn edit lần 2 để sửa mới gõ được tiếng việt.

    Nên chăng các anh thay cái hộp thoại bắt gõ tiếng việt bằng cách khác có tiện hơn không (VD khi nhấn nút gửi bài thì 1 hộp thông báo bung ra chi cho user biết đoạn chưa có tiếng Việt)

  5. Đã đăng · Trả lời báo cáo

    1 đoạn lsp lấy giá trị của lwpolyline (VD lấy toạ độ điểm các đỉnh LWPOLYLINE) mong bác chỉ dùm

     

    Xem thêm đoạn code Getvert của bác SSG nhé :

     

    (defun GetVert (e / i L CL k x LL) ;;;Return list Point of all vertex from pline e
  (vl-load-com)
  (setq i 0 k 0 L nil)    
  (setq CL (ent_close e))
  (if (= CL 1)
    (setq k (fix (+ (vlax-curve-getEndParam e) 1)))
    (setq k (fix (+ (vlax-curve-getEndParam e) 2)))    
  )
  (repeat k
    (setq L (append L (list (vlax-curve-getPointAtParam e i))))
    (setq i (1+ i))
  )
  (foreach x L (if (/= x nil) (setq LL (append LL (list x)))) )
  LL
);
(defun ent_close (e / cl sp ep x_ep x_sp y_ep y_sp) ;Return integer value (0 or 1)
  (vl-load-com)
  (setq
     sp (vlax-curve-getStartPoint e)
     ep (vlax-curve-getEndPoint e)
     x_sp (cadr sp)  y_sp (car sp)
     x_ep (cadr ep)  y_ep (car ep)
  )
  (if (and (= x_sp x_ep) (= y_sp y_ep))    
    (setq cl 1) ;=1 is Close
    (setq cl 0) 
  )    
);

  6. Đã đăng · Trả lời báo cáo

    Tue_NV đã viết lại, sử dụnglệng MA của CAD, sử lý luôn cho ARC

     

    1. Cái lệnh MA này thì mình biết chứ nhưng làm theo yêu cầu đầu bài của bạn almodeus thôi, tức là chỉ MA width của PLINE thôi chứ ko MA để thay đổi cho các thuộc tính khác của 2obj như: Layer, Color... Các bạn dùng 2 cái lisp trên sẽ thấy nó khác biệt nhau về mục đích đó. Theo yêu cầu của đầu bài này thì không nên dùng (command "MATCHPROP" obj (setq ss (ssget '((0 . "*LINE,ARC")))) "") mà chỉ cần đoạn chọn 1 loạt đối tượng đích thông qua (setq ss (ssget)) là đủ.

    2. *LINE ??? mà SPLINE hình như cũng không có thuộc tính width đâu.

    3. Nếu đưa thêm cả ARC vào thì lệnh PEDIT vô tình cũng chuyển ARC này thành 1 PLINE khá đặc biệt đó, bạn thử kiểm nghiệm lại xem.

     

    (defun C:CTN (/ obj Vla-obj 2Width 2obj ss sslen)
 (vl-load-com)
 (setvar "CmdEcho" 0)
 (prompt "\n<< Match ConstantWidth LWPOLYLINE >>")
 (setq obj (car(entsel "\n1. Select source LWPOLYLINE: ")))
 (if obj
   (progn
     (if (/= (cdr(assoc 0 (entget obj)))"LWPOLYLINE")
(prompt "\n>>> Object must be LWPOLYLINE !")
(progn
  (setq Vla-obj (vlax-ename->vla-object obj))
  (setq 2Width(vla-get-ConstantWidth Vla-obj))
  (prompt "\n2. Select destination: ")
  (setq ss(ssget))
  (if ss (progn
	   (setq sslen (sslength ss))
	   (while (> sslen 0)
             (setq 2obj (ssname ss (setq sslen (1- sslen))))
	     (if (wcmatch (cdr(assoc 0 (entget 2obj)))"LINE")
	       (progn
	         (VL-CMDF "PEDIT" 2obj "Y" "")
	         (setq Vla-obj (vlax-ename->vla-object (entlast)))
	         (vl-catch-all-apply '(lambda()(vla-put-ConstantWidth Vla-obj 2Width)))			 
	       )
	       (progn
	         (setq Vla-obj (vlax-ename->vla-object 2obj))
                        (vl-catch-all-apply '(lambda()(vla-put-ConstantWidth Vla-obj 2Width)))			 
	       )
	     )
	   );while
  ))	  
)
     )
   )
 );if obj
 (setvar "CmdEcho" 1)
 (princ)
);

    • Vote tăng 1

  7. Đã đăng · Trả lời báo cáo

    Mỗi lần muốn tăng Width cho nhiều Line lại phải ngồi sài lisp chỉnh width...có bác nào viết zùm mình cái Lisp Match từ một Pline co độ dày sẵn cho một hay nhiều Line bất kì không...trên diễn đàn có match width nhưng chỉ ứng match từ Pline sang Pline chứ từ Pline sang Line ko được

     

    Cái Line không có thuộc tính width đâu bạn nhé, LWPOLYLINE thì mới có thuộc tính width thôi ah. Thử đoạn code sau xem sao.

     

    (defun C:CTN (/ obj Vla-obj 2Width 2obj)
 (vl-load-com)
 (setvar "CmdEcho" 0)
 (prompt "\n<< Match PLINE ConstantWidth - elleHCSC >>")
 (setq obj (car(entsel "\n1. Select source PLINE: ")))
 (if obj
   (progn
     (if (/= (cdr(assoc 0 (entget obj)))"LWPOLYLINE")
(prompt "\n>>> Object must be PLINE !")
(progn
  (setq Vla-obj (vlax-ename->vla-object obj))
  (setq 2Width(vla-get-ConstantWidth Vla-obj))
  (while (setq 2obj (car(entsel "\n2. Select destination LINE, PLINE:")))
           (if 2obj
      (progn
	(if (= (cdr(assoc 0 (entget 2obj)))"LINE")
	  (progn
	    (VL-CMDF "PEDIT" 2obj "Y" "")
	    (setq Vla-obj (vlax-ename->vla-object (entlast)))
	     (vl-catch-all-apply
	       '(lambda()
	          (vla-put-ConstantWidth Vla-obj 2Width)
	       )
	     )	    
	  )
	  (progn
	    (setq Vla-obj (vlax-ename->vla-object 2obj))
	     (vl-catch-all-apply
	       '(lambda()
	          (vla-put-ConstantWidth Vla-obj 2Width)
	       )
	     )		    
	  )
	);if LINE
      )
    )
         );while
)
     )
   )
 );if obj
 (setvar "CmdEcho" 1)
 (princ)
);

  8. Đã đăng · Trả lời báo cáo

    Em chào bác các bác!

    em muốn các bác giúp em viết cái lisp chuyển text các cao độ trong Autocad sang file dạng *.txt, để em chạy san nền HS3.0 với.

    File từ cad sang kiểu như thế này:

    http://www.cadviet.com/upfiles/3/xuat_tu_cad_sang_txt.rar

    Mong các Bác giúp đỡ

     

    Cái file TXT bạn gửi kèm có định dạng là gì vậy ? phải giải thích rõ mới xuất text ra file cho bạn được chứ .

     

    Cột 1: STT

    Cột 2 : X hay Y

    Cột 3 : Xy hay Y

    Cột 4 : ???

    Cột 5 : Text cao độ

  9. Đã đăng · Trả lời báo cáo

    Mình nghĩ bạn đang lẫn lộn giữa khái niệm "làm rỗng tập chọn": (setq dt nil) với "xoá đối tượng": (ssdel ent dt) của Acad. Bác Gia_bach và vuvuzela đã giải thích rõ cả rồi. Theo mình hiểu thì nôm na như này:

     

    (setq dt (ssget)) = chọn đối tượng - select items --> (setq dt nil) = unselect items, khác hoàn toàn với (ssdel ent dt)- xoá object, loại bỏ object (delete items) khỏi database của ACAD.

     

    Chúc vui.

  10. Đã đăng · Trả lời báo cáo

    Chào cả nhà.

    em muốn tạo vòng lập while

    trong đó nhóm dtượng ban đầu là dt (ssget) chẵn hạn. sau đó em muốn làm rỗng tập hợp chọn dt ban đầu để em dùng hàm ssadd thêm vào nó những dtượng mới.

    VD như em dùng đoạn lisp sau:

    (defun c:KO()

    (setq dt (ssget)

    index 0)

    (setq sdt (sslength dt))

     

    (repeat sdt

    (setq ent (ssname dt index)

    index (1+ index))

    (setq dt (ssdel ent dt))

    )

    (princ (sslength dt))

    )

    đây là một lisp em viết thử để khử các dtượng trong tập hợp dt ban đầu bằng hàm ssdel và vòng lập repeat. nhưng nó báo lỗi các bác ah.

    xin chỉ giáo giùm em.

    hoặc có cách nào làm cho tập hợp dt ban đầu ko còn dt nào cả. khi dùng hàm (sslength dt) có giá trị bằng 0 nha.

    vì nếu xóa dt thì nó vẫn hiểu dt gồm cá dt đã bị xóa.

    chúc cả nhà ăn tết vui vẽ và nhiều sức khỏe

     

    (setq dt nil) hoặc (setq dt()) là khử 1 phát hết luôn chứ bạn entdel từng ent trong tập dt làm gì nhỉ ?

  11. Đã đăng · Trả lời báo cáo

    Chào bác Giabach,

    Bác có thể hướng dẫn thêm về vấn đề: "Trong VD trên tôi mở file với thuộc tính là BackRound hay InVisible." này hay không????

    Quả thực đây là một vấn đề mà mình cũng loay hoay chưa tìm ra lời giải. Mở một file text thì qua diễn đàn và các bác chỉ dẫn mình đã hiểu được và có thể sử dụng, Nhưng mở các file bản vẽ .DWG hay thậm chí .sldpart ra để xử lý trong lisp thì mình chưa biết cách. Rất mong bác chỉ giáo thêm.

    Cám ơn bác trước.

     

    Thấy các bác tham gia sôi nổi quá nên mình cũng đoán mò thôi nhá :

     

    Anh Gia Bach là đại gia Visual Lisp trên diễn đàn này mà nên chắc chắn đã dùng đến VL thì hiển nhiên có thể hỉểu nó là ActiveX. Mò mãi trong Help của CAD thấy có đoạn này và đoán mò GiaBach dùng tới các Method open và save để mở và lưu bản vẽ ở dạng Background, nhưng vẫn chưa hiểu anh Bach tìm và thay thế mấy cái text kia bằng kiểu gì ?!

     

    http://www.cadviet.com/upfiles/3/anh1.rar

     

    @ Trungngamy: Trước tôi cũng có dùng ActiveX của thằng www.opendwg.org (giờ đổi thành http://www.opendesign.com) và thông qua các hàm API của nó viết ứng dụng bằng Delphi để đọc, mở, chèn các obj vào dwg, save lại mà không cần phải mở dwg đó ra. Bạn qua đó down về và trải nghiệm (vì chắc bạn viết thành thục delphi) thì cũng sẽ đoan đoán được cách làm của Gia Bach (tức là dùng VLisp - là 1 dạng ActiveX để làm thôi).

    • Vote tăng 2

  12. Đã đăng · Trả lời báo cáo

    Nhờ các bạn viết dùm mình lisp dùng để Erase short object và Extend undershoots được ko ah?Do em làm quy hoạch hay xử lý nền địa chính mà bên đo đạc gửi qua, nhưng bên đó vẽ ẩu nên có những line nó ngắn quá làm chưa kín thửa, hoặc nó vẽ dài quá dư!

    - Đối với lisp Erase short object thì cho phép người nhập khoảng cách dư dài nhất thì các đoạn nhỏ hơn nó sẽ tự hiểu và Trim.

    - Đối với lisp Extend undershoots Lisp cũng vậy, cho phép người nhập giá trị MAX cần extend thì các đồi tượng có giá trị nhỏ hơn sẽ tự động extend!

    Cảm ơn các bạn trước!

    Cho mình gửi file ví dụ nhe!

    http://www.cadviet.com/upfiles/2/vd_5.dwg

     

    Bạn kiếm và cài phiên bản AutoCad Map vào mà dùng...trong đó nó có tool "Cleanup" làm được tất cả các yêu cầu của bạn với "chi phí" 8.000 VND

     

    clean001.jpg

     

    Chúc vui !

  13. Đã đăng · Trả lời báo cáo

    cám ơn bác nhé, những lệnh vừa rồi cũng thật là tuyệt nhưng vẫn chưa được theo ý em muốn. ý em là mình dùng lệnh hoặc (lisp) nào đó mà khi đánh lệnh xong enter thì tất cả các lớp bị khoá đều được mở khoá. cách của bác CHIEWATER cũng được nhưng dùng thế thì phải chọn nhiều lệnh quá. mong các bác chỉ giáo giùm. thanks :cheers:

     

    Lao gia trần này lười quá, bó tay...

     

    Lão thử cái lisp này xem có hợp ý ko nha, lệnh là BKL (bỏ khoá lớp) :

     

    (defun C:BKL ()
  (command "-Layer" "Unlock" "*" "")
  (prompt "\n>>> Tat ca cac lop da duoc bo khoa - Unlock all layer - he he...")
)

     

    Lão "ap" để load cái lisp này vào để chạy nhé, hoặc cho nó vào startup suite của Cad...

    • Vote tăng 4

  14. Đã đăng · Trả lời báo cáo

    Chào cả nhà !

     

    Dùng lisp có cách nào để xác định được mình đang dùng CAD loại gì không nhỉ, như : AutoCAD 2004, hay AutoCAdMap 2004 hay AutoCAD architec, AutoCAD Civil chẳng hạn.

     

    Trong Cad có biến AcadVer nhưng cái này chỉ xác định version của Acad. ví dụ ACADVER = "16.0s (LMS Tech)" (read only) gì gì đó.

     

    Mình hay dùng ACADMap mà trong ACADMap có một số lệnh không có trong ACAD khác, mục đích là viết mấy đoạn lisp và cần xác định nếu nó là ACADMap thì chức năng đó chạy (gọi lệnh của cad) còn không phải thì thôi (không có cái lệnh đó để mà gọi ra...)

     

    Tks !

  17. Đã đăng · Trả lời báo cáo

    Yêu cầu này thiết thực, ứng dụng mạnh trong thành lập bản đồ. Sao không bác nào giúp một cái lisp như vậy nhỉ

     

    Từ lúc nói cái ý tưởng này viết trên lisp cho đến hiện nay thì cũng là một thời gian khá dài elleHCSC tiếp cận và để tâm tới viết bằng lisp trên CAD và cũng đã hoàn thành bước 1 nghĩa là đã nối được theo tên điểm mia trên màn hình. Chỉ oái oăm nhất là mình chưa tìm thấy cái edit_text dạng multi_line trên cad đâu cả...nên hiện giờ mỗi lần nối chỉ nhập số liệu được trên có 1 dòng lệnh (command line) nên hạn chế có 256 ký tự. Các bạn chờ 1 thời gian mình tìm hiểu thêm rồi public lên sau nha !

     

    http://www.cadviet.com/upfiles/2/noi_diem_video.rar

     

    Ngày cuối tuần vui vẻ !

    • Vote tăng 1

  19. Đã đăng · Trả lời báo cáo

    File của bạn chả sao cả, máy tớ mở vù vù...16Mb ăn thua gì, tớ phải mở cái file 50 mb là chuyện cơm bữa...Cấu hình máy tớ cũng bình bình mà: Intel Dual core E5200, ram 2G, HDD là 2 cái 80gb chập làm 1 chạy RAID_0 (Strip), VGA rời 128 Mb

     

    Nhiều người khi mua chọn máy PC theo cái khái niệm CPU to cứ tưởng là nó khoẻ nhưng với CAD thế đâu đã đủ ! Có khi cấu hình lớn nhưng bị nghẹn cổ chai ở cái HDD cũng nên.

     

    - VGA rời và ram của VGA lớn thì càng tốt

    - Ram của máy lớn (2mb chắc đủ, hơn thì tốt quá)

    - HDD đọc ghi phải nhanh (nếu có điều kiện thì làm 2 cái và chạy chế độ Raid_0 - Raid_control phụ thuộc vào Main_Board nhé )

    - CPU nên chọn của AMD (nóng tý nhưng từ xửa đến nay về tốc độ thì riêng với CAD và MAX thì AMD lúc nào cũng dẫn điểm trước Intel. Các bạn cứ tìm trên các test_Lab của ta hay tây thì sẽ thấy...)

  20. Đã đăng · Trả lời báo cáo

    Các bạn test cái elleHCSC viết xem nhé, mình chạy thấy nó ổn:

    ;;---------------------------------------------------------------------------------Test func
(defun C:CC ( / ss1 col)
 (vl-load-com)
 (prompt "\n<< Change color for TEXT, MTEXT only >>")
 (initget (+ 1 2 4))
 (setq col (getint "\n - Color (from 1 to 255, 256 for ByLayer)?: "))
 (setq ss1 (ssget (list(cons 0 "*TEXT"))))
 (DoiMau1 ss1 col)
 (princ)
)
;;---------------------------------------------------------------------------------Test func
(defun DoiMau1 (ss mau / ent i j Vla-obj mt mc tmp tf bef aff ret)
 (setq i 0)
 (setq tmp (strcat "C" (itoa mau)))  
 (while (< i (sslength ss))
   (setq ent (ssname ss i))
   (setq Vla-obj (vlax-ename->vla-object ent))
   (if (= (cdr (assoc 0 (entget ent))) "MTEXT")
     (progn
(setq mt (vlax-get-property Vla-obj 'TextString))	
;find color def
(setq j (vl-string-search (strcase "\\c") mt))
(if (/= j nil)
  (progn
    (setq bef (SubStr mt 1 j))
    (setq ret (vl-string-left-trim bef mt))
    (setq tf (LeftStr ";" ret))
    (setq aff (vl-string-left-trim tf ret))
    (setq mc (strcat bef "\\" tmp aff))    
    (vlax-put-property Vla-obj 'TextString mc)	    
  )
  (vlax-put-property Vla-obj 'Color mau)
);if
     );
     (vlax-put-property Vla-obj 'Color mau) ;for TEXT obj
   );if
   (setq i (1+ i))
 )
)
;;---------------------------------------------------------------------------------Test func
(Defun LeftStr (Key Str / S i n)
 (if (or Str Key)
   (Progn
     (Setq i 1 n(Strlen Str))
     (While (and (<= i n) (/= Key (SubStr Str i 1)))
(Setq i (+ 1 i))
     );while
     (Setq S (SubStr Str 1 (- i 1)))
   );progn
 );if
 S
)
;;---------------------------------------------------------------------------------Test func

  22. Đã đăng · Trả lời báo cáo

    -Đường dẫn sao ko thấy ổ đĩa vậy anh?vậy MENU của em nằm trong ổ C:\Program Files\AutoCAD 2007\Support\MENU\tienich.mnu thì em phải ghi như thế nào?

    -Lisp của em là 1 lisp hoàn chỉnh,trong MENU chỉ gọi tên lệnh thôi!mà vẫn ko lặp lại được!

     

    Bạn tìm trên diễn đàn mục LandCadViet bác Ssg có thiết kế cái LCV đó, trong đó có mục load menu và unload menu chạy rất tốt, theo đó mà làm tiếp...

  24. Đã đăng · Trả lời báo cáo

    Bạn chạy thử Lisp Highlight đối tuợng Region bao ngoài (nếu có) trong tập hợp các đối tuợng Region.

    Sau đó việc erase, move, copy ... bạn tùy nghi xử lý.

    Chú ý : Lisp này không tạo ra Region mà chỉ chọn ra Region bao ngoài trong tập hợp các đối tuợng Region.

    (defun C:ssb(/ ss ss1 boundary e minPt maxPt )  ;select region boundary
 (vl-load-com)
 (setq ss1 (ssadd))
 (if (setq ss (ssget (list (cons 0 "REGION")  ) ) )
   (progn
     (setq boundary (boundarySS ss))
     (foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(vla-getBoundingBox e 'minPt 'maxPt)
(setq minPt (vlax-safearray->list minPt)
      maxPt (vlax-safearray->list maxPt))
(if (equal (list minPt  maxPt ) boundary 0.001)
  (setq ss1 (ssadd (vlax-vla-object->ename e) ss1))
  )
); foreach
     (if (>(sslength ss1)0)(sssetfirst nil ss1) )
     ); progn
   ); if  
 )
;ham tra ve 2 diem (LowerLeft TopRight) cua hinh chu nhat bao quanh cac doi tuong 
(defun boundarySS (ss / all_max all_min ll maxpt minpt ur); 
 (setq	all_min	(list)
all_max	(list)  ) 
 (foreach x (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
   (vla-GetBoundingBox x 'minpt 'maxpt)
   (setq all_min (cons (vlax-safearray->list minpt) all_min)
  all_max (cons (vlax-safearray->list maxpt) all_max)  )
   ) ;foreach
 (setq ll (list (car (vl-sort (mapcar 'car all_min) '<))
	 (car (vl-sort (mapcar 'cadr all_min) '<))
	 (car (vl-sort (mapcar 'caddr all_min) '<)) ) ;list
ur (list (last (vl-sort (mapcar 'car all_max) '<))
	 (last (vl-sort (mapcar 'cadr all_max) '<))
	 (last (vl-sort (mapcar 'caddr all_max) '<))) ;list
) ;setq
 (list ll  ur )
 )

     

    Chào Gia_bach mình đã thử đoạn code trên nhưng nó ko như được ý mình muốn. Kết quả của đoạn code trên nó cũng cho gần giống của TUE_NV nếu như khi chạy chọn tập các region rời rạc (mình chọn "all" region mỗi khi chạy ssb) thì kết quá nó báo là "nil". mình đã thử đi thử lại với nhiều bản vẽ.

     

    Tks bác gia_bach, quả là bác có nhiều chiêu hay quá...

  25. Đã đăng · Trả lời báo cáo

    Với những điều mà bạn TRUNGNGAMY nêu trên thì Tue_NV không thể giúp cho bạn elleHCSC được rồi vì khả năng của mình chưa có nhiều. Xin lỗi bạn elleHCSC vì Tue_NV không giúp gì cho elleHCSC được.

    Nếu bạn TRUNGNGAMY rãnh thì bạn trợ giúp cho elleHCSC 1 tay nhé.

    Cảm ơn.

    Hì hì, chào TRUNGNGAMY. Thực tế dùng CadMAP chạy topology xong thì việc tạo mấy cái vùng này là hoàn toàn tự động và dễ dàng việc này mình đủ khả năng và đã làm rồi chỉ vài dòng lisp thôi. Tuy nhiên mục tiêu của elle là làm 1 cái lisp để nó cũng tạo dc vùng thông qua lệnh Region của cad (chứ không dùng cadmap) vì một số người ko dùng CadaMap. Mình đang viết dở, nó cũng đã chạy OK chỉ có điều mắc mớ là tạo vùng xong thì nó lại thừa ra mấy cái vùng bao kia. Chỉ còn tìm cách xoá nó đi là bài toán đc giải quyết.

     

    OK từ gợi ý của bạn mình đã nghĩ đc 1 phương án rất đơn giản, để thử xem nó có ổn không.

     

    Tks all !

×