xin gúp đỡ lisp ve đường tâm

[nguyenbd1 13]

chào anh em trên diễn đàn hôm nay tớ xin hỏi anh em 1 vấn đề như sau..

tớ vừa viết 1 cái lisp đơn giản. tác dụng của nó là vẽ đường tâm cho đường tròn.. tất cả đều ổn. nhưng có 1 cái xin anh em sửa dùm: mỗi lần vẽ đường tâm tôi chỉ chọn được 1 đường tròn.. giờ nhờ anh em chỉnh lại dùm. gõ lệnh này xong tôi quyét tất cả đối tượng trong 1 vùng  trên bản vẽ.. lisp se tự nhận diện và vẽ đường tâm cho tất cả các đường tròn và cung tròn có trong vùng đó... cảm ơn anh em trước đây là link của lisp

[nguyenbd1 13]

http://www.cadviet.com/upfiles/3/122369_dc.lsp

[nguyenbd1 13]

sao không có cao thu nào gúp su đệ nay cả

[Doan Van Ha 3.196]

sao không có cao thu nào gúp su đệ nay cả

Bạn nghiên cứu về 2 vấn đề: chọn đối tượng theo điều kiện lọc + dùng vòng lặp.

[nguyenbd1 13]

bác hà ơi. sư đệ lisp gà lắm nên nhờ anh em trên diễn dàn,, trăm sự nhờ bác và các bậc tiền bối chiếu cố ạ

[toiyeuvietnam 0]

em ké 1 tí nhí vì chủ đề gần giống vậy!

 

các anh ơi cho em hỏi tí là có lisp nào có thể vẽ đường tim đường giựa trên cơ sở ta chọn 2 mép đường (có thể là Line hoặc Pline) của 2 bên đường, để xác định tâm giữa và vẽ tim đường luôn không nhỉ?

 

[Doan Van Ha 3.196]

em ké 1 tí nhí vì chủ đề gần giống vậy!

 

các anh ơi cho em hỏi tí là có lisp nào có thể vẽ đường tim đường giựa trên cơ sở ta chọn 2 mép đường (có thể là Line hoặc Pline) của 2 bên đường, để xác định tâm giữa và vẽ tim đường luôn không nhỉ?

Có hoặc có thể làm được, nhưng chưa thấy bản vẽ minh họa?

[hiepttr 538]

sao không có cao thu nào gúp su đệ nay cả

Bài trả lời của thấp thủ nhiều chuyện đây  :D :D :D

;Ve duong tam cho cac duong tron
(defun c:VT( / cmd os ss n i ten chuoi tam bk)
(setq cmd (getvar 'cmdecho)
	os (getvar 'osmode))
(mapcar 'setvar '("osmode" "cmdecho") '(0 0))
(if (setq ss (ssget (list (cons 0 "CIRCLE"))))
(progn 
(setq n (sslength ss)
	i 0)
(while (< i n)
(setq ten (ssname ss i)
	chuoi (entget ten)
	tam (cdr (assoc 10 chuoi))
	bk (cdr (assoc 40 chuoi)))
(command ".line" (polar (list (car tam) (cadr tam)) pi (+ 2 bk)) (polar (list (car tam) (cadr tam)) 0 (+ 2 bk)) "")
(command ".line" (polar (list (car tam) (cadr tam)) (/ pi 2) (+ 2 bk)) (polar (list (car tam) (cadr tam)) (* 3 (/ pi 2)) (+ 2 bk)) "")
(setq i (+ 1 i))
))
(princ "\nKhong co duong tron nao duoc chon !")
)
(mapcar 'setvar '("osmode" "cmdecho") (list os cmd))
(princ)
)

[TaiNguyen79 24]

em ké 1 tí nhí vì chủ đề gần giống vậy![/size]

 

các anh ơi cho em hỏi tí là có lisp nào có thể vẽ đường tim đường giựa trên cơ sở ta chọn 2 mép đường (có thể là Line hoặc Pline) của 2 bên đường, để xác định tâm giữa và vẽ tim đường luôn không nhỉ?[/size]

Đây nè bạn :

(defun c:chiatim(/ lstp p1 p2 midp)

(setq lstp '() osm (getvar "osmode")) (setvar "osmode" 129)

(initget 1) (setq p1 (getpoint "\n Chon diem thu nhat :")) (initget 1) (setq p2 (getpoint p1 "\n Chon diem thu hai :"))

(setq midp (acet-geom-midpoint p1 p2) lstp (append lstp (list midp)))

(initget 1) (setq p1 (getpoint "\n Chon diem tiep theo :")) (initget 1) (setq p2 (getpoint p1 "\n Chon diem tiep theo :"))

(setq midp (acet-geom-midpoint p1 p2) lstp (append lstp (list midp)))

(while (setq p1 (getpoint "\n Chon diem tiep theo :"))

(initget 1) (setq p2 (getpoint p1 "\n Chon diem tiep theo :") midp (acet-geom-midpoint p1 p2) lstp (append lstp (list midp))))

(acet-pline-make (list lstp)) (setvar "osmode" osm)(princ))

Cứ chọn 1 diểm bên này đường , rồi qua bên kia đường chọn 1 điểm là hình chiếu vuông góc của nó. Cứ thế và cứ thế sẽ cho kết quả tương đối chính xác.

[Doan Van Ha 3.196]

Học trò thầy Ket (Hiepttr í) mau tiến bộ nhỉ!

Dùng mapcar cho setvar thì nghiên cứu dùng mapcar cho getvar luôn cho nó... oai?

[hiepttr 538]

Dùng mapcar cho setvar thì nghiên cứu dùng mapcar cho getvar luôn cho nó... oai?

 

cái đó chỉ là ăn cắp của Bác để viết cho nhanh thôi

mình chỉ đang cố để viết sao cho Cad nó đọc đc & hạn chế dần lỗi thôi chứ oai thì nào có dám mơ :D :D :D

[nguyenbd1 13]

thành thật cảm on bác hiepttr. nó thật tuyệt.... chỉ có 1 cái nhỏ nữa thoi.. đó là các đường tâm em cần là các đường center, màu đỏ và đường tâm này tỉ lệ(linetype sacle) thay đổi  theocác đường tròn to, nhỏ.

[hiepttr 538]

thành thật cảm on bác hiepttr. nó thật tuyệt.... chỉ có 1 cái nhỏ nữa thoi.. đó là các đường tâm em cần là các đường center, màu đỏ và đường tâm này tỉ lệ(linetype sacle) thay đổi  theocác đường tròn to, nhỏ.

Ngoài ra còn thêm đk phần mút thừa cũng tỉ lệ luôn :D

 

;Ve duong tam cho cac duong tron
(defun c:VT( / cmd os cel lay ss n i ten chuoi tam bk)
(setq cmd (getvar 'cmdecho)
	os (getvar 'osmode)
	cel (getvar 'CELTSCALE)
	lay (getvar 'Clayer))
(mapcar 'setvar '("osmode" "cmdecho") '(0 0))
(if (not (tblsearch "layer" "tam-db1"))
(command "-layer" "m" "tam-db1" "c" 1 "" "l" "center" "" "") 
(setvar 'clayer "tam-db1"))
(if (setq ss (ssget (list (cons 0 "CIRCLE"))))
(progn 
(setq n (sslength ss)
	i 0)
(while (< i n)
(setq ten (ssname ss i)
	chuoi (entget ten)
	tam (cdr (assoc 10 chuoi))
	bk (cdr (assoc 40 chuoi)))
(setvar 'CELTSCALE (/ bk 5))
(command ".line" (polar (list (car tam) (cadr tam)) pi (+ (/ bk 10) bk)) (polar (list (car tam) (cadr tam)) 0 (+ (/ bk 10) bk)) "")
(command ".line" (polar (list (car tam) (cadr tam)) (/ pi 2) (+ (/ bk 10) bk)) (polar (list (car tam) (cadr tam)) (* 3 (/ pi 2)) (+ (/ bk 10) bk)) "")
(setq i (+ 1 i))
))
(princ "\nKhong co duong tron nao duoc chon !")
)
(mapcar 'setvar '("osmode" "cmdecho" "CELTSCALE" "Clayer") (list os cmd cel lay))
(princ)
)

[toiyeuvietnam 0]

cảm ơn anh tainguyen79 rất nhiều! bây giờ đỡ phải vẽ Pline và vẽ lại tâm nữa rồi. à có thể sửa được để chỉ cần chọn 2 mép bên đường (bằng đường Pline) là vẽ luôn cho mình tim không nhỉ?

 

  

[nguyenbd1 13]

rất cảm on sư phụ hiepttr rất nhiều.. quả thật khả năng autolisp của anh rất pro...co dịp nhất định em se bái đại ca làm sư phụ..

và em có 1 điều nữa xin sư phụ chiếu cố.. em cần 1 cái lisp vẽ hình tròn mà lúc vẽ ra có cả đường tâm. cái đường tâm đó cũng có màu đỏ là đường center, bề rộng của đường tâm là 0.09 và bề rộng layer đường tròn là 0.2.

ví dụ vẽ đường tròn có đường kính 80.2..gõ dòng command: c80.2  chọn 1 điểm cần đặt . lập tức xuất hiện 1 đường tròn có đủ tính chất trên. và tâm đường tròn phải đúng tâm của vị trí mà em cần đặt.

còn 1 yêu cầu nữa. khi vẽ xong đường tròn này muốn vẽ các đường tròn giống hệt đường tròn cần vẽ xong. chỉ cần chọn các điểm đặt tâm đường tròn chứ không cần phải thực hiện lại lệnh... em biết la không dễ để viết được lisp như vậy.. nhưng em nghĩ với khả năng của bác.. không phải quá khó.. em xin đa tạ bác trước. đây là líp em mày mò.. nhưng không đạt đầy đủ các yêu cầu trênhttp://www.cadviet.com/upfiles/3/122369_dd_3.lsp

[Doan Van Ha 3.196]

cảm ơn anh tainguyen79 rất nhiều! bây giờ đỡ phải vẽ Pline và vẽ lại tâm nữa rồi. à có thể sửa được để chỉ cần chọn 2 mép bên đường (bằng đường Pline) là vẽ luôn cho mình tim không nhỉ?  

Đây là lisp vẽ đường tâm của 2 đường cong hở, của Alan J. Thompson, khá là hay.

 

; Draw (LW)Polyline between two selected curves (at midpoint of vertices).
(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))
 

[hoangkimoanh 2]

oh, cảm ơn anh rất nhiều! em tìm khá lâu và mỏi mắt mà không tìm thấy. bây giờ thì tiện lợi rất nhiều rồi!

[hiepttr 538]

rất cảm on sư phụ hiepttr rất nhiều.. quả thật khả năng autolisp của anh rất pro...co dịp nhất định em se bái đại ca làm sư phụ..

và em có 1 điều nữa xin sư phụ chiếu cố.. em cần 1 cái lisp vẽ hình tròn mà lúc vẽ ra có cả đường tâm. cái đường tâm đó cũng có màu đỏ là đường center, bề rộng của đường tâm là 0.09 và bề rộng layer đường tròn là 0.2.

ví dụ vẽ đường tròn có đường kính 80.2..gõ dòng command: c80.2  chọn 1 điểm cần đặt . lập tức xuất hiện 1 đường tròn có đủ tính chất trên. và tâm đường tròn phải đúng tâm của vị trí mà em cần đặt.

còn 1 yêu cầu nữa. khi vẽ xong đường tròn này muốn vẽ các đường tròn giống hệt đường tròn cần vẽ xong. chỉ cần chọn các điểm đặt tâm đường tròn chứ không cần phải thực hiện lại lệnh... em biết la không dễ để viết được lisp như vậy.. nhưng em nghĩ với khả năng của bác.. không phải quá khó.. em xin đa tạ bác trước. đây là líp em mày mò.. nhưng không đạt đầy đủ các yêu cầu trênhttp://www.cadviet.com/upfiles/3/122369_dd_3.lsp

:D :D :D

Được voi con... đòi voi mẹ >>>>> mình có voi mẹ

Được voi mẹ... đòi Hai Bà Trưng >>>>> mình chịu

:D :D :D

Quả thật y/c đó với mình bây giờ là "quá xa xỉ" :D

Chắc bạn phải đợi các cao thủ khác ra tay vậy !

P/s: mắt nhất là cái lệnh c80.2, mình vẫn chưa thể hiểu & thực hành đc thuật toán này

Nếu có cao thủ nào đi ngang qua xin mổ xẻ dùm lisp dưới đây (của thầy Ketxu)

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/69469-yeu-cau-can-lisp-rut-gon-lenh-fillet/
;Fillet voi ban kinh bat ky, nhap lenh theo cau truc Rbankinh (R10, R100, R50, R1.5 ...)
;Ketxu 20/3/13

;Nguyen tac : giong ky thuat hook, tuc la khi ban gui 1 yeu cau nao do cho CAD de CAD thuc hien, ta chan yeu cau do lai, xu ly, sau do moi gui den cho CAD. Trong vi du nay, khi gui 1 lenh ma CAD khong biet, ta se chan no lai, kiem tra xem ten lenh co phai bat dau bang chu R hay khong (R1,R2...). Neu phai, ta se gui cho CAD yeu cau la lam lenh fillet ban kinh 1,2 ... Trong CAD, cai nay goi la re-actor

;Load VL
(vl-load-com)
;Kiem tra xem reactor fillet_reactor da co chua
(if (null fillet_reactor)
   ; Neu chua co thi add vao. Reactor nay co tac dung goi ham fillet_df moi khi cad thuc hien mot Unknown-     ;   command (tuc la lenh ma cad khong hieu)
  (setq fillet_reactor (vlr-command-reactor nil '((:vlr-unknownCommand . fillet_df)))))

;Dinh nghia ham fillet_df - a b la 2 tham so bat buoc. Trong do b chinh la dong lenh ma ta gui cho CAD
(defun	fillet_df (a b / cmd r)	
         
	(cond
                 ;Kiem tra lenh co chu R khong, neu co thi lay phan so o dang sau lam ban kinh r
		((and (wcmatch (setq cmd (strcase (nth 0 b))) "R*")(setq r (distof (substr cmd 2))))
                         ;Thiet dat ban kinh r cho lenh fillet.
			(setvar 'FILLETRAD r)
                         ;Gui lenh fillet den CAD bang VL, khong su dung command o day
			(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "fillet m ")			
		)
	)
	(princ)
)

[ketxu 2.984]

Đã comment trong code

[nguyenbd1 13]

đúng thật em đòi hỏi quá đáng với bác hiệp... dù sao cũng cảm ơn bác rất là nhiều

[Tue_NV 3.912]

cảm ơn anh tainguyen79 rất nhiều! bây giờ đỡ phải vẽ Pline và vẽ lại tâm nữa rồi. à có thể sửa được để chỉ cần chọn 2 mép bên đường (bằng đường Pline) là vẽ luôn cho mình tim không nhỉ?

 

  

 

Bạn  sử dụng Lisp timsong (tìm tim sông) của Tue_NV đã viết ở đây : 

http://www.cadviet.com/forum/topic/205-viet-lisp-theo-yeu-cau/page-99

Bài viết số 1967

[TaiNguyen79 24]

Bạn  sử dụng Lisp timsong (tìm tim sông) của Tue_NV đã viết ở đây : 

http://www.cadviet.com/forum/topic/205-viet-lisp-theo-yeu-cau/page-99

Bài viết số 1967

Góp ý chút nha : chia tim chưa chính xác so với chia thủ công.

Với lại nếu chọn ngược lại pl2 rồi pl1 sẽ cho ra tim khác với pl1 rồi pl2.

[hoangkimoanh 2]

đúng rồi, nó chỉ tương đối đúng với 2 đường song song, còn 2 đường zic zac thì không đúng!

[Tue_NV 3.912]

Góp ý chút nha : chia tim chưa chính xác so với chia thủ công.

Với lại nếu chọn ngược lại pl2 rồi pl1 sẽ cho ra tim khác với pl1 rồi pl2.

 

đúng rồi, nó chỉ tương đối đúng với 2 đường song song, còn 2 đường zic zac thì không đúng!

 

Vậy theo 2 bạn, chia thủ công như thế nào cho đúng??

[TaiNguyen79 24]

Vậy theo 2 bạn, chia thủ công như thế nào cho đúng??

Chia tim từng cặp đoạn thẳng (Dùng pháp vector chính xác hơn là dùng đường trung tuyến). Rồi giao hội tim của chúng lại (chamfer) , nếu không sẽ bị sai tại góc ngoặt của tim tuyến.