Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
limfx

Get '(42 . x) at Param in list data lwpolyline

Bởi limfx , trong AutoLisp

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

limfx    21

limfx
Đã đăng

Có cách nào  lấy thông số x nằm trong '(42 . x) của tập list data lwpolyline để hiệu chỉnh tại một vị trí  Param  mà em pick vào đường pline để hiệu chỉnh? Thanks!

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

tannguyen291    135

tannguyen291
Đã đăng

(vla-getbulge Object<vla-object> Index<integer>)

(vla-setbulge Object<vla-object> Index<integer> Value<double>)

 

Nếu không thích vla thì chơi bài lọc phần tử theo cách cơ bản nhất. mỗi vertex chỉ có 5 code dfx thôi mà: 10 40 41 42 91

(setq pos (vl-position (assoc 10 enx) enx))

(setq bulg (cdr (nth (+ (* i 5) 3 pos) enx) ))

 

Kết hợp với hàm subst nth của ông thần lee mac thì chiến mọi lwpline 

www.lee-mac.com/substn.html

  • 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

tien2005    241

tien2005
Đã đăng 
(defun getDxfs(lstId en)(vl-remove-if-not '(lambda(x)(vl-position (car x) lstId)) (entget en)))

code trên cũng của cadviet

ex: (getDxfs '(10 42)(car(entsel "\nDoi tuong :")))

kq:( (10 598937.0 1.21987e+006) (42 . 0.0) (10 599034.0 1.21995e+006) (42 . -0.368232) (10 599320.0 1.21995e+006) (42 . 0.0) ....)

  • 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

limfx    21

limfx
Đã đăng

image.png.7dabdd2b3ffefd8e9feaf4652e99c552.png

Em đang viết lisp tạo cung tròn và giữ lại đỉnh, em muốn nối pline vừa chọn và cung tròn mới tạo thành 1 pline liên tục mới. Nhưng pedit ssadd chỉ nối được đoạn sau, sửa giúp em để nối luôn đoạn trước. Thanks! 

(defun c:BOR ()
  (setq cmd (getvar 'CMDECHO))
  (setvar 'CMDECHO 0)
  (while (setq pl (entsel "\nSelect pline: "))
  (setq ss (ssadd))
  (setq lst nil)
  (setq r (getR))
  (setq plo (vlax-ename->vla-object (car pl)))
  (setq pt (vlax-curve-getclosestpointto plo (cadr pl)))
  (setq n (vlax-curve-getparamatpoint plo pt))
  (setq p2 (vlax-curve-getpointatparam plo (setq par (fix (+ 0.5 n)))))
  (setq p1 (vlax-curve-getpointatparam plo (1- par)))
  (setq l21 (- (vlax-curve-getDistAtPoint plo p2) (vlax-curve-getDistAtPoint plo p1)))
  (setq p3 (vlax-curve-getpointatparam plo (1+ par)))
  (setq l32 (- (vlax-curve-getDistAtPoint plo p3) (vlax-curve-getDistAtPoint plo p2)))
  (setq ang ((lambda (a) (min a (- (+ pi pi) a)))
      (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
  ))
  (setq ang (/ ang 2))
  (setq lr (/ r (/ (sin ang) (cos ang))))
  (while (or (> lr l21) (> lr l32))
    (progn
      (alert "\nR too big, Enter again R: ")
      (setq r (getR))
      (setq lr (/ r (/ (sin ang) (cos ang))))
    );progn
  );if
	 
  ;(setq lr (* r (atan (/ ang 2))))
  (setq p1t (polar p2 (angle p2 p1) lr))
  (setq p3t (polar p2 (angle p2 p3) lr))
  (setq ptem (mapcar '(lambda (x y) (/ (+ x y) 2)) p1t p3t))
  (setq Lr (sqrt (+ (expt lr 2) (expt r 2))))
  (setq p2t (polar p2 (angle p2 ptem) (- Lr r)))
  (setq bulge ((lambda ( a ) (/ (sin a) (cos a))) (/ (+ (- pi (angle p2t p1t)) (angle p2t p3t)) 2)))
  (setq ocs (trans '(0 0 1) 1 0 t))
  (setq lst (list p1t p2 p3t))
  (setq arc (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 2)
               '(070 . 0)
                (cons 038 (caddr (trans p1t 1 ocs)))
                (cons 010 (trans p1t 1 ocs))
                (cons 042 bulge)
                (cons 010 (trans p3t 1 ocs))
                (cons 210 ocs)
            )
        )
  )
  (ssadd (entlast) ss)
  (apply 'vl-cmdf (list "break" (car pl) p1t p3t))
  (ssadd (entlast) ss)
  (command "_.pedit" "_multiple" ss ""  "_join" "" "")
  (setq plgoc (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length lst))
                     );list
                    (mapcar (function (lambda (p) (cons 10 p))) lst))))  
  );while
  (setvar 'CMDECHO cmd)
  (print "limfx")
);end

(defun getR ()
  (if r (setq rm (getreal (strcat "\nRadius <" (rtos r 2 1) ">: "))) (setq r (getreal "\n\nEnter radius <1>: ")))
  (if (not r) (setq r 1) (if (not rm) (setq r r) (setq r rm)))
);end

 

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

limfx    21

limfx
Đã đăng
1 giờ trước, cuongtk2 đã nói:

Em nên dùng entlast làm chốt chặn để tính entnext.

Em chưa hiểu lắm anh. Nếu sét pline là (setq e1 (entlast)) thì sau khi break ra làm 2 phần
(setq e2 (entnext e1)) chỉ nhận được phần sau. Vậy muốn nhận phần đầu thì sao anh? Thanks!

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

limfx    21

limfx
Đã đăng
1 giờ} trướ}c, cuongtk2 đã nói:

Chưa nghe chuyện đếm con bò à. Phải tính cả con mình đang cưỡi chứ. (car pl) đó em.

 

image.thumb.png.7201f98ae010d0b62cc3e07e7352f447.png

Em chỉnh lại OK rồi anh. Cảm ơn sự giúp đỡ của anh! 

(defun c:BOR ()
  (setq cmd (getvar 'CMDECHO))
  (setvar 'CMDECHO 0)
  (while (setq pl (entsel "\nSelect pline: "))
  (setq ss (ssadd))
  (setq lst nil)
  (setq r (getR))
  (setq plo (vlax-ename->vla-object (car pl)))
  (setq pt (vlax-curve-getclosestpointto plo (cadr pl)))
  (setq n (vlax-curve-getparamatpoint plo pt))
  (setq p2 (vlax-curve-getpointatparam plo (setq par (fix (+ 0.5 n)))))
  (setq p1 (vlax-curve-getpointatparam plo (1- par)))
  (setq l21 (- (vlax-curve-getDistAtPoint plo p2) (vlax-curve-getDistAtPoint plo p1)))
  (setq p3 (vlax-curve-getpointatparam plo (1+ par)))
  (setq l32 (- (vlax-curve-getDistAtPoint plo p3) (vlax-curve-getDistAtPoint plo p2)))
  (setq ang ((lambda (a) (min a (- (+ pi pi) a)))
      (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
  ))
  (setq ang (/ ang 2))
  (setq lr (/ r (/ (sin ang) (cos ang))))
  (while (or (> lr l21) (> lr l32))
    (progn
      (alert "\nR too big, Enter again R: ")
      (setq r (getR))
      (setq lr (/ r (/ (sin ang) (cos ang))))
    );progn
  );if
	 
  ;(setq lr (* r (atan (/ ang 2))))
  (setq p1t (polar p2 (angle p2 p1) lr))
  (setq p3t (polar p2 (angle p2 p3) lr))
  (setq ptem (mapcar '(lambda (x y) (/ (+ x y) 2)) p1t p3t))
  (setq Lr (sqrt (+ (expt lr 2) (expt r 2))))
  (setq p2t (polar p2 (angle p2 ptem) (- Lr r)))
  (setq bulge ((lambda ( a ) (/ (sin a) (cos a))) (/ (+ (- pi (angle p2t p1t)) (angle p2t p3t)) 2)))
  (setq ocs (trans '(0 0 1) 1 0 t))
  (setq lst (list p1t p2 p3t))
  (setq arc (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 2)
               '(070 . 0)
                (cons 038 (caddr (trans p1t 1 ocs)))
                (cons 010 (trans p1t 1 ocs))
                (cons 042 bulge)
                (cons 010 (trans p3t 1 ocs))
                (cons 210 ocs)
            )
        )
  )
  (ssadd (entlast) ss)
  (apply 'vl-cmdf (list "break" (car pl) p1t p3t))
  (ssadd (entlast) ss)
  (ssadd (car pl) ss)
  (command "_.pedit" "_multiple" ss ""  "_join" "" "")
  (setq plgoc (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length lst))
                     );list
                    (mapcar (function (lambda (p) (cons 10 p))) lst))))  
  );while
  (setvar 'CMDECHO cmd)
  (print "limfx")
);end

(defun getR ()
  (if r (setq rm (getreal (strcat "\nRadius <" (rtos r 2 1) ">: "))) (setq r (getreal "\n\nEnter radius <1>: ")))
  (if (not r) (setq r 1) (if (not rm) (setq r r) (setq r rm)))
);end

 

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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×