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

tien2005

Thành viên
  • Số lượng nội dung

    404
  • Đã tham gia

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

  • Ngày trúng

    21

Mọi thứ được đăng bởi tien2005

  1. tien2005

    Nhờ các anh e trong diễn đàn sửa giúp lips

    Đây nhé (defun c:test1 (/ ss) (vl-load-com) (if (setq ss (ssget (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE")))) (foreach pt (getSS_Inter ss) ;;; (entmake (list (cons '0 "POINT") (cons '10 pt))) (entmake (list (cons '0 "CIRCLE") (cons '10 pt) (cons '40 10) (cons '8 "0") ) ;_ end of list ) ;_ end of entmake ) ;_ end of foreach ) ;_ end of if (princ) ) ;_ end of defun (defun giao (ob1 ob2 / inter_lst iplist) (if (not (vl-catch-all-error-p (setq iplist (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone) ) ;_ end of vlax-variant-value ) ;_ end of list ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not (progn (while (setq inter_lst (cons (list (car iplist) (cadr iplist) (caddr iplist)) inter_lst ) ;_ end of cons iplist (cdddr iplist) ) ;_ end of setq ) ;_ end of while (reverse inter_lst) ) ;_ end of progn ) ;_ end of if ) ;_ end of defun (defun getSS_Inter (ss / e giao_lst i lst obj tmp_lst) (setq i -1) (while (setq e (ssname ss (setq i (1+ i)))) (setq lst (cons (vlax-ename->vla-object e) lst)) ) ;_ end of while (repeat (1- (vl-list-length lst)) (setq obj (car lst)) (foreach ob1 (setq lst (vl-remove obj lst)) (if (setq tmp_lst (giao ob1 obj)) (foreach pt tmp_lst (if (not (vl-position pt giao_lst)) (setq giao_lst (cons pt giao_lst)) ) ;_ end of if ) ;_ end of foreach ) ;_ end of if ) ;_ end of foreach ) ;_ end of repeat giao_lst ) ;_ end of defun
×