Đến nội dung


Hình ảnh
- - - - -

[Help] Lisp Tạo Trục Đối Xứng Cách Đều 2 Đường Cho Trước


  • Please log in to reply
10 replies to this topic

#1 Trnghiado

Trnghiado

    biết vẽ arc

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

Đã gửi 31 October 2016 - 10:55 AM

Chào anh em
Mình muốn nhờ anh em làm giúp lisp tạo tâm đối xứng (như hình vẽ)

https://drive.google...iew?usp=sharing
Nhập lệnh  : cl
Quét chọn các đối tượng muốn tạo trục đối xứng
Yêu cầu là trục đối xứng sẽ nằm trong lớp có tên " Centerline".
Thanks anh em !


  • -1

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 31 October 2016 - 11:44 AM

http://www.cadviet.c...g-tam/?p=247501

 

Tìm kiếm GG bằng keyword hoàn toàn tiếng việt :

"đường cách đều 2 đường lisp cad"


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 Trnghiado

Trnghiado

    biết vẽ arc

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

Đã gửi 31 October 2016 - 01:13 PM

http://www.cadviet.c...g-tam/?p=247501

 

Tìm kiếm GG bằng keyword hoàn toàn tiếng việt :

"đường cách đều 2 đường lisp cad"

Hi bác Ket, link bác post em đã tìm và có thử các lisp mà các anh em đã làm. Tuy nhiên đều ko đúng với ý của em lắm. Dù sao cũng cám ơn bác đã chia sẻ giúp ah :)


  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 31 October 2016 - 02:47 PM

Nếu bạn còn chưa nói ra "đều ko đúng với ý của em lắm" là như thế nào thì e rằng sẽ còn chờ đợi lâu. Gluck ^^


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#5 Trnghiado

Trnghiado

    biết vẽ arc

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

Đã gửi 31 October 2016 - 03:01 PM

Nếu bạn còn chưa nói ra "đều ko đúng với ý của em lắm" là như thế nào thì e rằng sẽ còn chờ đợi lâu. Gluck ^^

Trong link bác đưa ra có 3 lisp, 1 lisp chỉ tạo đc đg tâm cho hình tròn , 1 lisp"chiatim" thì cách chọn là 2 lần chọn điểm của 2 đg. Với 2 đg song song thì kết quả đúng ý em. Nếu 2 đg tạo thành góc và có độ dài khác nhau thì tùy vào điểm chọn sẽ tạo 2 đg tim khác nhau. Mà em muốn là đg tâm tạo ra nó như dạng (phân giác ) và chọn là quét chọn cùng lúc đối tượng luôn bác ạ :v . Còn 1 lisp "lbl" thì em add vào ko dùng đc bác ạ :(


  • 0

#6 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 31 October 2016 - 03:28 PM

(defun c:LBL (/ foo AT:GetSel _pnts _pline _lwpline _dist e1 e2)
 (vl-load-com)
 (defun foo (e)
  (and (wcmatch (cdr (assoc 0 (entget (car e)))) "LINE,*POLYLINE,SPLINE")
   (not (vlax-curve-isClosed (car e)))))
 (defun AT:GetSel (meth msg fnc / ent)
  (while
   (progn
    (setvar 'ERRNO 0)
    (setq ent (meth (cond (msg) ("\nSelect object: "))))
    (cond
   ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
     ((eq (type (car ent)) 'ENAME)
      (if (and fnc (not (fnc ent)))
       (princ "\nInvalid object!"))))))
  ent)
 (defun _pnts (e / p l)
  (if e
   (cond
    ((wcmatch (cdr (assoc 0 (entget e))) "ARC,LINE,SPLINE")
     (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e)))
    ((wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE")
     (repeat (setq p (1+ (fix (vlax-curve-getEndParam e))))
      (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l)))))))
 (defun _pline (lst)
  (if
   (and
    (> (length lst) 1)
    (entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . 8)))
    (foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32)))))
   (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))))
 (defun _lwpline (lst)
  (if (> (length lst) 1)
   (entmakex (append
     (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) (cons 70 (* (getvar 'plinegen) 128)))
     (mapcar (function (lambda (p) (list 10 (car p) (cadr p)))) lst)))))
 (defun _dist (a b)
  (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
  (if
   (and
    (setq e1 (_pnts (car (AT:GetSel entsel "\nSelect first open curve: " foo))))
    (setq e2 (_pnts (car (AT:GetSel entsel "\nSelect next open curve: " foo))))
    (not (initget 0 "Lwpolyline Polyline"))
    (setq *LBL:Opt* (cond ((getkword (strcat "\nSpecify line to draw: [Lwpolyline/Polyline] <" (cond (*LBL:Opt*) ((setq *LBL:Opt* "Lwpolyline"))) ">: "))) (*LBL:Opt*))))
   ((if (eq *LBL:Opt* "Lwpolyline") _lwpline _pline)
    (vl-remove nil
     (mapcar (function (lambda(a b) 
   (if (and a b (not (grdraw (trans a 0 1) (trans b 0 1) 1 1)))
    (mapcar (function (lambda (a b) (/ (+ a b) 2.))) a b))))
       e1
      (if (< (_dist (car e1) (car e2)) (_dist (car e1) (last e2))) e2 (reverse e2))))))
 (princ))

  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 Trnghiado

Trnghiado

    biết vẽ arc

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

Đã gửi 31 October 2016 - 04:53 PM

(defun c:LBL (/ foo AT:GetSel _pnts _pline _lwpline _dist e1 e2)
 (vl-load-com)
 (defun foo (e)
  (and (wcmatch (cdr (assoc 0 (entget (car e)))) "LINE,*POLYLINE,SPLINE")
   (not (vlax-curve-isClosed (car e)))))
 (defun AT:GetSel (meth msg fnc / ent)
  (while
   (progn
    (setvar 'ERRNO 0)
    (setq ent (meth (cond (msg) ("\nSelect object: "))))
    (cond
   ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
     ((eq (type (car ent)) 'ENAME)
      (if (and fnc (not (fnc ent)))
       (princ "\nInvalid object!"))))))
  ent)
 (defun _pnts (e / p l)
  (if e
   (cond
    ((wcmatch (cdr (assoc 0 (entget e))) "ARC,LINE,SPLINE")
     (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e)))
    ((wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE")
     (repeat (setq p (1+ (fix (vlax-curve-getEndParam e))))
      (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l)))))))
 (defun _pline (lst)
  (if
   (and
    (> (length lst) 1)
    (entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . 8)))
    (foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32)))))
   (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))))
 (defun _lwpline (lst)
  (if (> (length lst) 1)
   (entmakex (append
     (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) (cons 70 (* (getvar 'plinegen) 128)))
     (mapcar (function (lambda (p) (list 10 (car p) (cadr p)))) lst)))))
 (defun _dist (a b)
  (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
  (if
   (and
    (setq e1 (_pnts (car (AT:GetSel entsel "\nSelect first open curve: " foo))))
    (setq e2 (_pnts (car (AT:GetSel entsel "\nSelect next open curve: " foo))))
    (not (initget 0 "Lwpolyline Polyline"))
    (setq *LBL:Opt* (cond ((getkword (strcat "\nSpecify line to draw: [Lwpolyline/Polyline] <" (cond (*LBL:Opt*) ((setq *LBL:Opt* "Lwpolyline"))) ">: "))) (*LBL:Opt*))))
   ((if (eq *LBL:Opt* "Lwpolyline") _lwpline _pline)
    (vl-remove nil
     (mapcar (function (lambda(a b) 
   (if (and a b (not (grdraw (trans a 0 1) (trans b 0 1) 1 1)))
    (mapcar (function (lambda (a b) (/ (+ a b) 2.))) a b))))
       e1
      (if (< (_dist (car e1) (car e2)) (_dist (car e1) (last e2))) e2 (reverse e2))))))
 (princ))

Em đánh lệnh thì bị báo như này "Unknown command "LBL".  Press F1 for help." Em sử Cad Mechanical 2012, ko biết có phải do phiên bản cad ko nữa 


  • -1

#8 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 01 November 2016 - 08:52 AM

Bạn copy code vào file mới, k download nữa xem sao.


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#9 quang_lac

quang_lac

    biết lệnh mirror

  • Members
  • PipPipPip
  • 151 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 01 November 2016 - 03:30 PM

ko liên quan đến topic nhưng mọi người cho mình hỏi chút, dòng lệnh nào để thay đổi unit của block mà ko thay đổi unit của bản vẽ hiện hành ko. Dùng "insunits" có được ko mọi người nhỉ


  • 0

#10 Trnghiado

Trnghiado

    biết vẽ arc

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

Đã gửi 02 November 2016 - 03:46 PM

Bạn copy code vào file mới, k download nữa xem sao.

Lisp này khác xa yêu cầu em đặt ra. với 2 đường song song thì nó cho kết quả ưng ý. Tuy nhiên với 2 đường ko song song và có độ dài khác nhau, kết quả ra ko phải đường phân giác như em mong muốn. Dữ liệu chỉ là 2 đường thẳng dạng line nên em muốn đường đối xứng cũng chỉ dạng line, màu đỏ và thuộc layer tên là Centerline . Bác ketxu xem lại giúp em xem


  • 0

#11 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 411 Bài viết
Điểm đánh giá: 88 (tàm tạm)

Đã gửi 02 November 2016 - 03:58 PM

Nếu bạn dùng cad 2017, thì có tính năng Centerline sẽ đáp ứng được yêu cầu của bạn, đường tim đó còn tự thay đổi khi bạn xoay 2 đoạn thẳng gốc.

Tham khảo video


  • 0