Đến nội dung


Hình ảnh
- - - - -

Nhờ Các Cao Thủ Giúp Mình Thêm Point Vào Giao Điểm Các Pline


  • Please log in to reply
3 replies to this topic

#1 CAD_vimsat

CAD_vimsat

    Chưa sử dụng CAD

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

Đã gửi 03 August 2016 - 07:50 PM

[Yêu Cầu]Mình có các đường pline giao nhau xin nhờ các cao thủ giúp mình viết lisp hộ:

1: Thêm các point đó vào giao điểm các đường pline

2: Chiếu hoặc move các giao điểm đó lên một đường thẳng...

Mình cảm ơn các cao thủ nhiều  :)


  • -2

#2 CAD_vimsat

CAD_vimsat

    Chưa sử dụng CAD

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

Đã gửi 03 August 2016 - 11:41 PM

có ai giúp mình với?


  • 0

#3 trandangquang92

trandangquang92

    biết vẽ ellipse

  • Members
  • PipPip
  • 56 Bài viết
Điểm đánh giá: -17 (hơi kém)

Đã gửi 05 August 2016 - 03:40 PM

bạn phải trình bày dưới dạng hình ảnh ý tưởng hoặc đính kèm cad, chứ k hiểu ý tưởng sao giúp


  • 0

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 05 August 2016 - 09:47 PM

Này bạn! Chú ý: Line AB phải đủ dài để hình chiếu luôn nằm trong AB, nếu không thì phải sửa lisp tí. 

(defun C:HA(/ ss ln lst)
 (defun #Inter:1SS(ss / a b i j l)
  (repeat (setq i (sslength ss))
   (setq a (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
   (repeat (setq j i)
    (setq b (vlax-ename->vla-object (ssname ss (setq j (1- j)))) l (cons (#Inter:2Obj a b acExtendNone) l))))
  (apply 'append (reverse l)))
 (defun #Inter:2Obj(obj1 obj2 flag / l r)
  (setq l (vlax-invoke obj1 'intersectwith obj2 flag))
  (repeat (/ (length l) 3)
   (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))
  (reverse r))
 (defun MPoint (pt) (entmake (list (cons 0 "POINT") (cons 10 pt))))
 (princ "\nChon cac Pline...")
 (if
  (and
   (setq ss (ssget '((0 . "*line"))))
   (setq ln (car (entsel "\nChon Line de chieu hoac move: "))))
  (progn 
   (initget "C M")
   (setq wd (getkword "\nChon hinh thuc [Chieu/Move] <M>: "))
   (setq lst (#Inter:1SS ss))
   (cond
    ((or (= wd "M") (not wd)) (mapcar '(lambda(pt) (Mpoint (vlax-curve-getClosestPointTo ln pt))) lst))
    ((= wd "C") (mapcar '(lambda(pt) (Mpoint pt) (Mpoint (vlax-curve-getClosestPointTo ln pt))) lst)))))
 (princ))

  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.