Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
congltce

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

Các bài được khuyến nghị

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

  • Vote tăng 1
  • Vote giảm 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.676

Đâ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"))
;----------
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×