Đến nội dung


Hình ảnh
- - - - -

vẽ line or polyline trim


  • Please log in to reply
24 replies to this topic

#21 snowman.hms

snowman.hms

    biết vẽ ellipse

  • Members
  • PipPip
  • 54 Bài viết
Điểm đánh giá: 26 (tàm tạm)

Đã gửi 25 May 2015 - 08:26 PM

 

Pls, help me =VBA với   :D  :P , lisp mình mù tịt ko biết gì, VBA thì mình còn mò được, cho mình cái sườn thôi cũng được nữa, giúp mính với nhé . tks all

 

(defun c:rcn (/ s i e el lst vl cn dir foo fun)
  (if (setq s (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
    (progn
      (initget "Vertical Horizontal")
      (setq dir
	     (eq
	       "Vertical"
	       (getkword
		 "\nConnect direction [Vertical/Horizontal]??? <Horizontal> > : "
	       )
	     )
      )
      (repeat (setq i (sslength s))
	(setq e	 (ssname s (setq i (1- i)))
	      el (entget e)
	)
	(if (Rectangle-p el)
	  (setq	vl  (_massoc 10 el)
		cn  (apply
		      (function _mid)
		      (mapcar '(lambda (x) (apply 'mapcar (cons x vl)))
			      '(min max)
		      )
		    )
		lst (cons (list cn e) lst)
	  )
	)
      )      
      (if dir
	(setq foo (lambda (a b) (equal (caar a) (caar b) 0.01))
	      fun (lambda (a b) (< (cadar a) (cadar b)))
	)
	(setq foo (lambda (a b) (equal (cadar a) (cadar b) 0.01))
	      fun (lambda (a b) (< (caar a) (caar b)))
	)
      )
      (setq lst	(mapcar	'(lambda (x) (vl-sort x (function fun)))
			(LM:GroupByFunction lst foo)
		)
      )
      (foreach l lst
	(mapcar '(lambda (a b) (_connect a b)) l (cdr l))
      )
    )
  )
  (princ)
)
;;---------------------------------------------------------------;;
(defun _massoc (key lst)
  (if (setq itm (assoc key lst))
    (cons (cdr itm) (_massoc key (cdr (member itm lst))))
  )
)
;;---------------------------------------------------------------;;
(defun _mid (a b)
  (mapcar (function (lambda (a b) (/ (+ a b) 2.0))) a b)
)
;;---------------------------------------------------------------;;
(defun Rectangle-p (el / lst p1 p2 p3 p4)
  (and
    (= "LWPOLYLINE" (cdr (assoc 0 el)))
    (= 1 (cdr (assoc 70 el)))
    (setq lst (_massoc 10 el))
    (= 4 (length lst))
    (vl-every
      '(lambda (x) (zerop x))
      (_massoc 42 el)
    )
    (mapcar '(lambda (v p) (set v p)) '(p1 p2 p3 p4) lst)
    (equal 1 (/ (distance p1 p2) (distance p3 p4)) 1e-9)
    (equal 1 (/ (distance p1 p4) (distance p2 p3)) 1e-9)
    (equal 1 (/ (distance p1 p3) (distance p2 p4)) 1e-9)
  )
)
;;---------------------------------------------------------------;;
(defun _line (p1 p2)
  (entmakex
    (list
      (cons 0 "LINE")
      (cons 10 p1)
      (cons 11 p2)
    )
  )
)
;;---------------------------------------------------------------;;
(defun _connect (l1 l2)
  (_line (vlax-curve-getclosestpointto (cadr l1) (car l2))
	 (vlax-curve-getclosestpointto (cadr l2) (car l1)))
)
;;---------------------------------------------------------------;;
;; Group By Function  -  Lee Mac
;; Groups items considered equal by a given predicate function

(defun LM:GroupByFunction ( lst fun / tmp1 tmp2 x1 )
    (if (setq x1 (car lst))
        (progn
            (foreach x2 (cdr lst)
                (if (fun x1 x2)
                    (setq tmp1 (cons x2 tmp1))
                    (setq tmp2 (cons x2 tmp2))
                )
            )
            (cons (cons x1 (reverse tmp1)) (LM:GroupByFunction (reverse tmp2) fun))
        )
    )
)
;;---------------------------------------------------------------;;
(vl-load-com)
;|«Visual LISP© Format Options»
(70 2 1 2 nil "_eof " 100 9 0 0 1 T T T T)
;*** DO NOT add text below the comment! ***|;


  • 0

#22 banmethuoc1112

banmethuoc1112

    biết zoom

  • Members
  • Pip
  • 10 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 26 May 2015 - 01:37 PM

B)


  • 0

#23 snowman.hms

snowman.hms

    biết vẽ ellipse

  • Members
  • PipPip
  • 54 Bài viết
Điểm đánh giá: 26 (tàm tạm)

Đã gửi 26 May 2015 - 09:43 PM

không vừa ý à  banmethuoc1112? :)


  • 0

#24 banmethuoc1112

banmethuoc1112

    biết zoom

  • Members
  • Pip
  • 10 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 May 2015 - 09:38 AM

hi, snowman ơi giúp mình một cái sườn bằng vba cad được hem? híc  :P


  • 0

#25 xetainamviet

xetainamviet

    Chưa sử dụng CAD

  • Advance Member
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 May 2015 - 09:48 AM

1. VBA hoàn toàn có thể làm được!

2. Đấy là do đề bài đặt ra 

 

"1. Qui luật của các hình chữ nhật như thế nào? => hình chữ nhật luôn thằng hàng với nhau, còn bề rộng có thể thay đổi

2. Quy luật vẽ các Line như thế nào? => cái polyline đucợ vẽ từ mép ngoài cùng bên trái đến mép ngoài cùng bên phải đó snowman.hms"

còn muốn lập lisp theo các phương khác thì hoàn toàn có thể   :)

thanks cad việt , mình đã biết thêm học hỏi mọi người về cad 


  • 0