(Xin Lisp) Lisp Boundary Thành 1 Hình.

[congltce 0]

Chào các anh chị!

Hiện tai mình đang dùng lệnh BO nhiều đối tượng dính với nhau, nhưng muốn các đối tượng sau khi BO sẽ thành 1 hình duy nhất.

Anh chị nào có lòng giúp em cái lisP như vậy được không ạ.

nói thì khó hiểu. các anh chị xem file đính kèm: http://www.cadviet.com/upfiles/5/118737_bo.dwg

[ceddtu 6]

Có cao thủ nào giúp bạn ấy với, mình cũng hóng 1 cái lisp như vậy. :P

[Doan Van Ha 3210]

Đây là lisp tạo đường biên, của nước ngoài.

 

;---------- Co the dung lenh REGION va UNION neu cac duong kin
;---------- lib:IsPtInView. Kiem tra xem lieu 1 diem co nam trong viewport. Auguments: 'pt'  mot diem de phan tich trong cac MSC. Return : T hoac nil neu 'pt' o trong khung nhin hay khong
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
 (setq pt (trans pt 0 1))
 (setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
       SSZ (getvar "SCREENSIZE") X_Pix (car SSZ) Y_Pix (cadr SSZ)
       X_Len (* (/ X_Pix Y_Pix) Y_Len)
       Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len))
       Uc (polar Lc 0.0 X_Len) Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len))
       Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)))
 (if (and (> (car pt) (car Lc)) (< (car pt) (car Uc)) (> (cadr pt) (cadr Lc)) (< (cadr pt) (cadr Uc)))
  T
  nil))
(defun DTR (a)
 (* pi (/ a 180.0)))
(defun RTD (a)
 (/ (* a 180.0) pi))
;---------- lib:Zoom2Lst. Function: Zoom danh sach cac diem bien. Arguments: 'vlist' 1 danh sach cac diem trong MSC. Zoom man hinh de thay tat ca cac diem co the nhin thay. Returns: t co duoc phong to, nil khong co
(defun lib:Zoom2Lst( vlist / bl tr Lst OS)
 (setq Lst (lib:pt_extents vlist) bl (car Lst) tr (cadr Lst))
 (if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
  (progn
   (setq OS (getvar "OSMODE")) (setvar "OSMODE" 0)
   (command "_.Zoom" "_Window" (trans bl 0 1) (trans tr 0 1) "_.Zoom" "0.95x")
   (setvar "OSMODE" OS) T) NIL))
;---------- lib:pt_extents. Function : tra ve gioi han cua MIN, MAX X,Y,Z danh sach cac diem. Argument: 'vlist' 1 danh sach diem. Returns: danh sach cac diem
(defun  lib:pt_extents (vlist / tmp)
 (setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x))
   (mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist)) '(0 1 2))))
 (list (mapcar '(lambda(x) (apply 'min x)) tmp) (mapcar '(lambda(x) (apply 'max x)) tmp)))
;========== HAM CHINH: tao duong bien cho cac doi tuong. http://www.caduser.ru/forum/index.php...&TID=30797. External contour of objects
(defun C:ECO ( / *error* blk obj MinPt MaxPt hiden pt pl unnamed_block isRus tmp_blk adoc blks lays lay oname sel csp loc sc ec ret DS osm)
 (defun *error* (msg)
  (mapcar '(lambda (x) (vla-put-Visible x :vlax-true)) hiden)
  (vla-endundomark adoc)
  (if (and tmp_blk (not (vlax-erased-p tmp_blk)) (vlax-write-enabled-p tmp_blk))
   (vla-Erase tmp_blk))
  (if osm (setvar "OSMODE" osm))
  (foreach x loc 
   (vla-put-lock x :vlax-true)))
 (vl-load-com) (setvar "CMDECHO" 0) (setq osm (getvar "OSMODE"))
 (if (zerop (getvar "WORLDUCS"))
  (progn (vl-cmdf "_.UCS" "") (vl-cmdf "_.Plan" "")))
 (setq isRus (= (getvar "SysCodePage") "ANSI_1251")) ;1251 la ma ANSI cua tieng Nga, 1252 la ma ANSI cua tieng Anh
 (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
       blks (vla-get-blocks adoc) lays (vla-get-layers adoc))
 (vla-startundomark adoc)
 (if isRus (princ "\nВыберите объекты для построения контура") (princ "\nSelect objects for making a contour"))
 (if (setq sel (ssget))
 (progn
    (setq sel (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))))
    (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel))))
    (setq unnamed_block (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) "*U"))
    (foreach x sel
      (setq oname (strcase (vla-get-objectname x)) lay  (vla-item lays (vla-get-layer x)))
        (if (= (vla-get-lock lay) :vlax-true)
          (progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc))))
      (cond ((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION")) nil)
       ((= oname "ACDBBLOCKREFERENCE")
        (vla-InsertBlock unnamed_block
          (vla-get-insertionpoint x) (vla-get-name x)
          (vla-get-xscalefactor x) (vla-get-yscalefactor x)
          (vla-get-zscalefactor x) (vla-get-rotation x))
        (setq blk (cons x blk)))
       (t (setq obj (cons x obj)))));_foreach
        (setq lay  (vla-item lays (getvar "CLAYER")))
        (if (= (vla-get-lock lay) :vlax-true) (progn (vla-put-lock lay :vlax-false) (setq loc (cons lay loc))))
     (if obj (progn (vla-copyobjects (vla-get-activedocument (vlax-get-acad-object))
              (vlax-make-variant (vlax-safearray-fill
                  (vlax-make-safearray vlax-vbobject (cons 0 (1- (length obj))))
                  obj)) unnamed_block)))
    (setq obj (append obj blk))
    (if obj (progn
          (setq tmp_blk (vla-insertblock csp (vlax-3d-point '(0. 0. 0.)) (vla-get-name unnamed_block) 1.0 1.0 1.0 0.0))
          (vla-GetBoundingBox tmp_blk 'MinPt 'MaxPt)  ;_chan ranh gioi
               (setq MinPt (vlax-safearray->list MinPt) MaxPt (vlax-safearray->list MaxPt)
           DS (max (distance MinPt (list (car MinPt) (cadr MaxPt)))
              (distance MinPt (list (car MaxPt) (cadr MinPt))))
                DS (* 0.2 DS) ;1/5
           DS (max DS 10) MinPt (mapcar '- MinPt (list DS DS))
                     MaxPt (mapcar '+ MaxPt (list DS DS)))
(lib:Zoom2Lst (list MinPt MaxPt)) (setq sset (ssget "_C" MinPt MaxPt))
(if sset (progn (setvar "OSMODE" 0)
      (setq hiden (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
       hiden (vl-remove tmp_blk hiden))
      (mapcar '(lambda(x) (vla-put-Visible x :vlax-false)) hiden)
      (setq pt (mapcar '+ MinPt (list (* 0.5 DS) (* 0.5 DS))))
      (vl-cmdf "_.RECTANG" (trans MinPt 0 1) (trans MaxPt 0 1))
      (setq pl (vlax-ename->vla-object(entlast)))
      (setq sc (1-(vla-get-count csp)))
      (if (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY '(lambda ()
         (vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")
              (while (> (getvar "CMDACTIVE") 0) (command "")))))
      (if isRus (princ "\nНе удалось построить контур") (princ "\nIt was not possible to construct a contour")))
      (setq ec (vla-get-count csp))
        (while (< sc ec) (setq ret (append ret (list (vla-item csp sc))) sc(1+ sc)))
      (setq ret (vl-remove pl ret))
      (mapcar '(lambda (x) (vla-Erase x) (vlax-release-object x)) (list pl tmp_blk)) (setq pl nil tmp_blk nil)
      (setq ret (mapcar '(lambda ( x / mipt) (vla-GetBoundingBox x 'MiPt nil)  ;_chan ranh gioi
                 (setq MiPt (vlax-safearray->list MiPt)) (list MiPt x)) ret))
      (setq ret (vl-sort ret '(lambda (e1 e2) (< (distance MinPt (car e1)) (distance MinPt (car e2))))))
      (setq pl (nth 1 ret) ret (vl-remove pl ret)) (mapcar 'vla-erase (mapcar 'cadr ret))
      (mapcar '(lambda(x) (vla-put-Visible x :vlax-true)) hiden)
      (foreach x loc (vla-put-lock x :vlax-true))
      (if pl (progn (initget  "Yes No")
      (if (= (getkword (if isRus "\nУдалять объекты? [Yes/No] <No> : " "\nDelete objects? [Yes/No] <No>: ")) "Yes")
         (mapcar '(lambda (x) (if (vlax-write-enabled-p x) (vla-Erase x))) obj)))
   (if isRus (princ "\nНе удалось построить контур") (princ "\nIt was not possible to construct a contour")))))))
     (VL-CATCH-ALL-APPLY '(lambda () (mapcar 'vlax-release-object (list unnamed_block tmp_blk csp blks lays))))));_if not
  (foreach x loc (vla-put-lock x :vlax-true)) (setvar "OSMODE" osm)
  (vla-endundomark adoc) (vlax-release-object adoc) (princ))
(if (= (getvar "SysCodePage") "ANSI_1251")
 (princ "\nНаберите в командной строке ECO")
(princ "\nType ECO in command line"))
;----------

[congltce 0]

 

Đây là lisp tạo đường biên, của nước ngoài.

;---------- Co the dung lenh REGION va UNION neu cac duong kin
;---------- lib:IsPtInView. Kiem tra xem lieu 1 diem co nam trong viewport. Auguments: 'pt'  mot diem de phan tich trong cac MSC. Return : T hoac nil neu 'pt' o trong khung nhin hay khong

load lisp xong, mình đánh lệnh ECO không được bạn ơi

[Doan Van Ha 3210]

Nó báo gì?

[congltce 0]

Nó báo gì?

unknown command "ECO". Please press F1 to help

[conghoa 137]

Bạn có thể dùng cái này

http://www.cadviet.com/upfiles/5/1969_eco_ve_polyline_bao_ngoai.lsp

[xuanhuy2011 5]

Bạn có thể dùng cái này. Đầu tiên bạn chọn điểm bên trong miền kín. Sau đo hàm tự tạo thành các pline kín thành region kín và ghép lại với nhau.Xong

http://www.cadviet.com/upfiles/5/142148_tao_bo.lsp