Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#1821 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 September 2010 - 11:41 PM

Em xin phép đào lại bài 1 chút,vì những thắc mắc của e bị trôi đi nhanh quá^^

Có cách nào khóa 1 đối tượng giống như đóng băng không ạ ? (k phải đóng băng layer chứa đối tượng đó)
Em thấy chức năng này rất cần thiết nhưng hình như chưa có
E nghĩ có cách là copy đối tượng sang 1 layer temp,layer này có tính chất giống layer của đối tượng,nhưng bị khóa.Sau khi unlock thì trả đối tượng về layer cũ và (có thể) xóa layer temp đi.Nhưng lại có vấn đề là nếu có nhiều đối tượng thuộc nhiều layer khác nhau thì phải tạo ra nhiều layer temp,hoặc phải lưu giữ thông tin của nhiều đối tượng trước khi bị khóa.Nhưng kể cả như vậy thì có thể thực hiênện được không ạ ??Em k biết lập trình nên không triển khai được ý đồ,mong các bác giúp đỡ ..

Bac tue nói có thể thực hiện,nên e vẫn mong ý đồ này được các bác giúp đỡ ^^

- Thực hiện lệnh bắn line (hoặc pline) vào giao điểm của 2 đường line gần nhất.Ở đầu vào User kích chọn vào đường line cần bắn.
- Thực hiện lệnh bắn line (hoặc pline) vào 1 điểm gấp khúc gần nhất của các đường pline xung quanh.Ở đầu vào User kích chọn vào đường line cần bắn và có lựa chọn pick hay không cần kick vào pline.(Giống lệnh ex,hay trim,có thể chọn hoặc không chọn đường biên ý ạ.vì có thể có nhiều pl xung quanh mũi đường l,pl gốc,người dùng không phải băn khoăn xem đường nào gần nhất).
Mong các bác giúp đỡ e vấn đề 1,còn vấn đề 2 thì với bản thân e chưa cần thiết lắm,e chỉ nghĩ nên mở rộng vấn đề như thế thôi.hì ^^

Hình đã gửi
Hình đã gửi
  • 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


#1822 790312

790312

    biết lệnh fillet

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

Đã gửi 18 September 2010 - 07:07 AM

Bạn tham khảo cái này thử xem: http://www.cadviet.c...showtopic=21470
Nó tạo ra block ATT như ý bạn.

Ý mình không phải vậy.Trong đoạn lisp mình gửi lên khi đánh CT thì mặc định nó sẽ vẽ biểu tượng cao trình mình chỉ cần chọn điểm để đặt nó thôi.Nhưng khi lisp tự vẽ biểu tượng cao trình này ra nó không phải là block ATT,nhờ các chỉnh sửa lisp này sao cho khi vẽ ra thì nó là BLock ATT.thanks
  • 0

#1823 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 18 September 2010 - 08:17 AM

mấy bác giúp em cái này với mà em không biết đặt câu hỏi ở đây có đúng không nữa.em co tải mấy lisp trên diễn đàn mình về mà không biết dùng(nghĩa là thao tác trên dòng command không biết kiểu sao hết, nhưng em biết tên lisp rùi) sao cả ,mấy bác coi giúp em voi.em cam ơn nhiều.http://www.cadviet.com/upfiles/3/tinhthang.lsp quả thật em mơi tập tành học cad nên còn dút lém :undecided: sẵn đây bác nào có lisp scale theo 2 trục x y không cho em xin với.

lisp scale theo 2 trục x y xem ở đây:
http://www.cadviet.c...o...near&start=
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#1824 dkkx3a

dkkx3a

    biết lệnh trim

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

Đã gửi 18 September 2010 - 09:02 AM

Ý mình không phải vậy.Trong đoạn lisp mình gửi lên khi đánh CT thì mặc định nó sẽ vẽ biểu tượng cao trình mình chỉ cần chọn điểm để đặt nó thôi.Nhưng khi lisp tự vẽ biểu tượng cao trình này ra nó không phải là block ATT,nhờ các chỉnh sửa lisp này sao cho khi vẽ ra thì nó là BLock ATT.thanks


Bạn tham khảo cái này nhé:

;VE CAO TRINH
(DEFUN C:CT (/ CMD NBC OSM PT1 TSIZE STR PRMT)
(if (not (tblsearch "layer" "ghichu"))
(command "layer" "m" "ghichu" "c" "150" """")
)

(if (not (tblobjname "block" "CTrinh"))
(taobl)
)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ NBC (GETVAR "CLAYER"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)(SETVAR "DIMZIN" 0)
(setvar "ATTMODE" 1)(setvar "attdia" 0)(setvar "attreq" 1)
(SETQ PT1 (GETPOINT "\nDiem cao trinh:"))
(if (not TSIZE1)
(SETQ TSIZE1 (GETVAR "TEXTSIZE"))
)
(SETQ STR (RTOS TSIZE1 2)
PRMT (STRCAT "\nText height <" STR ">:")
TSIZE (GETDIST PRMT)
)
(if (not TSIZE)
(SETQ TSIZE TSIZE1)
(SETQ TSIZE1 TSIZE)
)
(PRINC "\n")
(command "-insert" "CTrinh" PT1 TSIZE "" "0")
(SETVAR "CMDECHO" CMD)
(SETVAR "CLAYER" NBC)
(SETVAR "OSMODE" OSM)
(PRINC)
)
;---------------------
(defun taobl()
(entmake '((0 . "BLOCK")(2 . "CTrinh")(70 . 2)(10 0.0 0.0 0.0)))
(entmake
'((0 . "LINE")(62 . 150)(8 . "ghichu")
(10 -1.0 0.0 0.0)(11 1.0 0.0 0.0)))
(entmake
'((0 . "LINE")(62 . 7)(8 . "ghichu")
(10 0.0 0.0 0.0)(11 1.0 0.5 0.0)))
(entmake
'((0 . "LINE")(62 . 7)(8 . "ghichu")
(10 1.0 0.5 0.0)(11 -1.0 0.5 0.0)))
(entmake
'((0 . "LINE")(62 . 150)(8 . "ghichu")
(10 0.0 0.0 0.0)(11 0.0 3.0 0.0)))
(entmake
'((0 . "LINE")(62 . 150)(8 . "ghichu")
(10 -1.0 1.0 0.0)(11 4.5 1.0 0.0)))
(entmake
'((0 . "SOLID")(62 . 7)(8 . "ghichu")
(10 0.0 0.0 0.0)(11 0.0 0.5 0.0)
(12 -1.0 0.5 0.0)(13 0.0 0.5 0.0)
(39 . 0.0)))
(entmake
'((0 . "ATTDEF")(8 . "ghichu")
(10 0.25 1.50 0.0)
(1 . "0.00")
(2 . "CT_ID")
(3 . "Gia_tri_cao_trinh:")
(40 . 1.0)(41 . 1.0)
(50 . 0.0)(70 . 0)
(71 . 0)(72 . 0)(62 . 84)
(73 . 0)))
(entmake '((0 . "ENDBLK")))
)
;---------------------
(defun c:bn()
(command "osnap" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par" )
)


Có gì Post lại nhé!!!
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#1825 leolas

leolas

    biết lệnh stretch

  • CADViet Team
  • PipPipPip
  • 163 Bài viết
Điểm đánh giá: 133 (tàm tạm)

Đã gửi 18 September 2010 - 10:45 AM

Bác thử cái này nhé :


(defun c:veh(/ ID R1 H L tam maxp maxp_H minX maxX Lmin Lmax
g1 g2 e1 e2 e3 os)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq ID (getdist "\n Nhap tri so ID :")
R1 (* ID 0.9045) R2 (* ID 0.1728)
H (/ ID 4) L (* ID 0.3272)
)
(setq tam (getpoint "\n Chon diem tam cua cung R1 :"))
(setq maxp (list (car tam) (+ (cadr tam) R1) 0.0)
maxp_H (list (car tam) (- (+ (cadr tam) R1) H) 0.0)
minX (list (- (car tam) (/ ID 2)) (cadr maxp_H) 0.0)
maxX (list (+ (car tam) (/ ID 2)) (cadr maxp_H) 0.0)
Lmin (list (- (car tam) L) (cadr maxp_H) 0.0)
Lmax (list (+ (car tam) L) (cadr maxp_H) 0.0)
)
(command "circle" tam R1)(setq e1 (entlast))
(command "circle" Lmin R2)(setq e2 (entlast))
(command "circle" Lmax R2)(setq e3 (entlast))
(setq g1 (car (ACET-GEOM-INTERSECTWITH e1 e2 0)))
(setq g2 (car (ACET-GEOM-INTERSECTWITH e1 e3 0)))
(command "arc" "c" tam g2 g1)
(command "arc" "c" Lmin g1 minX)
(command "arc" "c" Lmax maxX g2)
(entdel e1) (entdel e2) (entdel e3)
(command "line" tam maxp "")
(command "line" Lmin g1 "")
(command "line" Lmax g2 "")
(command "line" minX maxX "")
(setvar "osmode" os)
(princ)
)

Cám ơn Bác Tuệ nhiều, bác bổ sung thêm đoạn đứng dài 50 hai bên như trong hình giùm, ở bất kỳ ID nào đều có đoạn này
  • 0
Let those who only see the thorns have eyes to see the rose

#1826 790312

790312

    biết lệnh fillet

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

Đã gửi 18 September 2010 - 10:56 AM

Bạn tham khảo cái này nhé:


;VE CAO TRINH
(DEFUN C:CT (/ CMD NBC OSM PT1 TSIZE STR PRMT)
(if (not (tblsearch "layer" "ghichu"))
(command "layer" "m" "ghichu" "c" "150" """")
)

(if (not (tblobjname "block" "CTrinh"))
(taobl)
)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ NBC (GETVAR "CLAYER"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)(SETVAR "DIMZIN" 0)
(setvar "ATTMODE" 1)(setvar "attdia" 0)(setvar "attreq" 1)
(SETQ PT1 (GETPOINT "\nDiem cao trinh:"))
(if (not TSIZE1)
(SETQ TSIZE1 (GETVAR "TEXTSIZE"))
)
(SETQ STR (RTOS TSIZE1 2)
PRMT (STRCAT "\nText height <" STR ">:")
TSIZE (GETDIST PRMT)
)
(if (not TSIZE)
(SETQ TSIZE TSIZE1)
(SETQ TSIZE1 TSIZE)
)
(PRINC "\n")
(command "-insert" "CTrinh" PT1 TSIZE "" "0")
(SETVAR "CMDECHO" CMD)
(SETVAR "CLAYER" NBC)
(SETVAR "OSMODE" OSM)
(PRINC)
)
;---------------------
(defun taobl()
(entmake '((0 . "BLOCK")(2 . "CTrinh")(70 . 2)(10 0.0 0.0 0.0)))
(entmake
'((0 . "LINE")(62 . 150)(8 . "ghichu")
(10 -1.0 0.0 0.0)(11 1.0 0.0 0.0)))
(entmake
'((0 . "LINE")(62 . 7)(8 . "ghichu")
(10 0.0 0.0 0.0)(11 1.0 0.5 0.0)))
(entmake
'((0 . "LINE")(62 . 7)(8 . "ghichu")
(10 1.0 0.5 0.0)(11 -1.0 0.5 0.0)))
(entmake
'((0 . "LINE")(62 . 150)(8 . "ghichu")
(10 0.0 0.0 0.0)(11 0.0 3.0 0.0)))
(entmake
'((0 . "LINE")(62 . 150)(8 . "ghichu")
(10 -1.0 1.0 0.0)(11 4.5 1.0 0.0)))
(entmake
'((0 . "SOLID")(62 . 7)(8 . "ghichu")
(10 0.0 0.0 0.0)(11 0.0 0.5 0.0)
(12 -1.0 0.5 0.0)(13 0.0 0.5 0.0)
(39 . 0.0)))
(entmake
'((0 . "ATTDEF")(8 . "ghichu")
(10 0.25 1.50 0.0)
(1 . "0.00")
(2 . "CT_ID")
(3 . "Gia_tri_cao_trinh:")
(40 . 1.0)(41 . 1.0)
(50 . 0.0)(70 . 0)
(71 . 0)(72 . 0)(62 . 84)
(73 . 0)))
(entmake '((0 . "ENDBLK")))
)
;---------------------
(defun c:bn()
(command "osnap" "")
(command "osnap" "End,Mid,Cen,Quad,Int,Perp,Tan,Near,App,Int,Ext,Par" )
)


Có gì Post lại nhé!!!

Cảm ơn bạn rất nhiều nhưng trong lisp của bạn cho gán tên layer cho đường thằng và solid nhưng sao không cho gán tên layer cho TEXT 0.00 .Mong bạn giúp giùm.
  • 0

#1827 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 18 September 2010 - 11:17 AM

Cám ơn Bác Tuệ nhiều, bác bổ sung thêm đoạn đứng dài 50 hai bên như trong hình giùm, ở bất kỳ ID nào đều có đoạn này

Của bác đây :


(defun c:veh(/ ID R1 H L tam maxp maxp_H minX maxX Lmin Lmax
g1 g2 e1 e2 e3 os)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq ID (getdist "\n Nhap tri so ID :")
R1 (* ID 0.9045) R2 (* ID 0.1728)
H (/ ID 4) L (* ID 0.3272)
)
(setq tam (getpoint "\n Chon diem tam cua cung R1 :"))
(setq maxp (list (car tam) (+ (cadr tam) R1) 0.0)
maxp_H (list (car tam) (- (+ (cadr tam) R1) H) 0.0)
minX (list (- (car tam) (/ ID 2)) (cadr maxp_H) 0.0)
maxX (list (+ (car tam) (/ ID 2)) (cadr maxp_H) 0.0)
Lmin (list (- (car tam) L) (cadr maxp_H) 0.0)
Lmax (list (+ (car tam) L) (cadr maxp_H) 0.0)
)
(command "circle" tam R1)(setq e1 (entlast))
(command "circle" Lmin R2)(setq e2 (entlast))
(command "circle" Lmax R2)(setq e3 (entlast))
(setq g1 (car (ACET-GEOM-INTERSECTWITH e1 e2 0)))
(setq g2 (car (ACET-GEOM-INTERSECTWITH e1 e3 0)))
(command "arc" "c" tam g2 g1)
(command "arc" "c" Lmin g1 minX)
(command "arc" "c" Lmax maxX g2)
(entdel e1) (entdel e2) (entdel e3)
(command "line" tam maxp "")
(command "line" Lmin g1 "")
(command "line" Lmax g2 "")
(command "line" minX (polar minX (- (/ pi 2)) 50) "")
(command "line" maxX (polar maxX (- (/ pi 2)) 50) "")
(command "line" (polar minX (- (/ pi 2)) 50)
(polar maxX (- (/ pi 2)) 50) "")

(setvar "osmode" os)
(princ)
)

  • 1

#1828 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 September 2010 - 11:35 AM

Em xin phép đào lại bài 1 chút,vì những thắc mắc của e bị trôi đi nhanh quá^^
Hình đã gửi

bạn dung thử cái này

;; free lisp from cadviet.com
(defun  C:ban ()
(princ "\nChon 2 duong giao nhau: ")
(setq ss1 (ssget '((0 . "line,lwpolyline"))))
(princ "\nChon cac duong muon ban: ")
(setq ss2 (ssget '((0 . "line,lwpolyline"))))
(setq p1 (cdr (assoc 10 (entget (ssname ss1 0)))))
(setq p2 (cdr (assoc 11 (entget (ssname ss1 0)))))
(setq p3 (cdr (assoc 10 (entget (ssname ss1 1)))))
(setq p4 (cdr (assoc 11 (entget (ssname ss1 1)))))
(setq gd (inters p1 p2 p3 p4))
(setq i 0)
(while (< i (sslength ss2))
(setq entname (ssname ss2 i)
pb1 (cdr (assoc 10 (entget entname)))
pb2 (cdr (assoc 11 (entget entname)))
l1 (distance pb1 gd)
l2 (distance pb2 gd)
)
(if (< l1 l2)
(command "move" entname "" pb1 gd)
(command "move" entname "" pb2 gd)
)
(setq i (1+ i))
)
)

  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#1829 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 18 September 2010 - 12:22 PM

Cám ơn Bác Tuệ nhiều, bác bổ sung thêm đoạn đứng dài 50 hai bên như trong hình giùm, ở bất kỳ ID nào đều có đoạn này

Hề hề hề,
Biếu bác Tài xài chơi coi có ưng ý không hè???? Có gì chưa ưng bác lại hỏi nữa nghen.

(defun c:velp ( / oldcmd oldos H ID L R1 R2 G O1 O2 O3 p1 p2 )
(command "undo" "be")
(setq oldcmd (getvar "cmdecho")
oldos (getvar "osmode" ))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq ID (getreal "\n Nhap gia tri duong kinh dinh bon: ")
H (/ ID 4)
L (* ID 0.3272)
R1 (* ID 0.9045)
R2 (* ID 0.1728)
G (atan (- R1 H) L)
O1 (getpoint "\n Chon diem tam cung R1")
O2 (polar O1 G (- R1 R2))
O3 (polar O1 (- pi G) (- R1 R2))
)
(command "arc" "c" O1 (polar O1 G R1) (polar O1 (- pi G) R1))
(command "arc" "c" O2 (setq p1 (polar O2 0 R2)) (polar O2 G R2))
(command "arc" "c" O3 (polar O3 (- pi G) R2) (setq p2 (polar O3 pi R2)))
(command "pline" p1 p2 (polar p2 (- (/ pi 2)) 50) (polar p1 (- (/ pi 2)) 50) p1 "")
(setvar "cmdecho" oldcmd)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)


PS: có cái ni bữa mô đi off Đè nẽng bác ôm đi mấy cái làm xuồng câu mực bác hỉ?????
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1830 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 September 2010 - 12:26 PM

Hề hề hề,
Đoạn lisp trên của bác nếu là để lấy tọa độ tâm của cái arc ở cuối đường pline thì có nhẽ đúng.......
Hề hề hề,.....

Đúng 50%, sai 50%

Hề hề Bác lại nói .... rồi.
biết toạ độ 2 điểm rồi thì lấy khoảng cách có khó gì....

Do đó, cái việc lấy khoảng cách -> Đúng 50%, sai 50%

Cái này bác nói ý thứ nhất thì đúng. Ý thứ 2 thì sai. vì chỉ cần lấy độ dài bán kính. Hì Hì
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#1831 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 September 2010 - 02:07 PM

bạn dung thử cái này

Cám ơn bạn nhìu.Lisp chạy tốt lắm.Nhưng ý đồ của mình là :
-Đầu vào user chỉ cần kick vào line cần bắn (ctrình tự tìm điểm giao nhau gần nhất của 2 đường khác)
- Line này giữ nguyên gốc
Lisp của bạn tương đương với việc mình dùng lệnh move rồi move cả line sang điểm giao đó (2 thao tác)
Ý của mình tương đương với việc kick vào line,rồi kéo đầu line vào điểm giao đó (2 thao tác)
Nếu dùng lisp thì 1 thao tác ^^
Cho mình hỏi luôn là có cách nào làm 3(hoặc nhiều hơn) đương thẳng trên tự động đồng quy tại điểm giao nhau của 2 đường thẳng biên không?
  • 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


#1832 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 18 September 2010 - 02:26 PM

Cái này bác nói ý thứ nhất thì đúng. Ý thứ 2 thì sai. vì chỉ cần lấy độ dài bán kính. Hì Hì

Tue_NV sai chổ nào vậy bạn?
Bạn nên nhớ rằng khoảng cách từ tâm cong đến các điểm trên cung đều bằng nhau và bằng bán kính cong.
Nếu khoảng cách từ tâm cong các điểm trên cung không bằng nhau là sai rồi bạn à
Nếu tôi chọn 1 điểm bất kì trên đường cong đến tâm cung như với Lisp của bạn đã viết thì có đúng 100% hay không?
  • 0

#1833 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 September 2010 - 03:18 PM

Cám ơn bạn nhìu.Lisp chạy tốt lắm.Nhưng ý đồ của mình là :
-Đầu vào user chỉ cần kick vào line cần bắn (ctrình tự tìm điểm giao nhau gần nhất của 2 đường khác)

cái này có thể làm được nhưng nó sẽ khá nặng nếu bản vẽ của bạn nhiều đối tượng.

- Line này giữ nguyên gốc
Lisp của bạn tương đương với việc mình dùng lệnh move rồi move cả line sang điểm giao đó (2 thao tác)
Ý của mình tương đương với việc kick vào line,rồi kéo đầu line vào điểm giao đó (2 thao tác)
Nếu dùng lisp thì 1 thao tác ^^

Cái này thì mình đã sửa lại cho bạn rồi nè:

(defun  C:ban2 ()
(princ "\nChon 2 duong giao nhau: ")
(setq ss1 (ssget '((0 . "line,lwpolyline"))))
(princ "\nChon cac duong muon ban: ")
(setq ss2 (ssget '((0 . "line,lwpolyline"))))
(setq p1 (cdr (assoc 10 (entget (ssname ss1 0)))))
(setq p2 (cdr (assoc 11 (entget (ssname ss1 0)))))
(setq p3 (cdr (assoc 10 (entget (ssname ss1 1)))))
(setq p4 (cdr (assoc 11 (entget (ssname ss1 1)))))
(setq gd (inters p1 p2 p3 p4))
(setq i 0)
(while (< i (sslength ss2))
(setq entname (ssname ss2 i)
pb1 (cdr (assoc 10 (entget entname)))
pb2 (cdr (assoc 11 (entget entname)))
l1 (distance pb1 gd)
l2 (distance pb2 gd)
)
(if (< l1 l2)
(progn
(setq thay (subst (cons 10 gd) (cons 10 pb1) (entget entname)))
(entmod thay)
)
(progn
(setq thay (subst (cons 11 gd) (cons 11 pb2) (entget entname)))
(entmod thay)
)
)
(setq i (1+ i))
)
)

Cho mình hỏi luôn là có cách nào làm 3(hoặc nhiều hơn) đương thẳng trên tự động đồng quy tại điểm giao nhau của 2 đường thẳng biên không?

với cả 2 lisp trên bạn thích bắn bao nhiêu đường vào điểm giao của 2 đường thẳng cũng được hết.
  • 2
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#1834 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 September 2010 - 03:39 PM

Tue_NV sai chổ nào vậy bạn?
Bạn nên nhớ rằng khoảng cách từ tâm cong đến các điểm trên cung đều bằng nhau và bằng bán kính cong.
Nếu khoảng cách từ tâm cong các điểm trên cung không bằng nhau là sai rồi bạn à
Nếu tôi chọn 1 điểm bất kì trên đường cong đến tâm cung như với Lisp của bạn đã viết thì có đúng 100% hay không?

Hề hề
Với lisp trên của mình nói là đúng 50% vì toạ độ của tâm mình không khống chế được lúc thì nó nhảy ra ngoài lúc thì nó nhảy vào trong như hình. Tiện thể bạn giải thích giùm mình luôn.
Nếu như bạn nói muốn chọn điểm bất kì trên cung đó thì phải lấy khoảng cách đểm đó tới tâm chứ ai lại lấy điểm đầu hay điểm cuối để tính bán kính. Cám ơn bạn đã gớp ý cho mình!! thank!!!
Hình đã gửi
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#1835 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 September 2010 - 03:46 PM

cái này có thể làm được nhưng nó sẽ khá nặng nếu bản vẽ của bạn nhiều đối tượng.

Cái này thì mình đã sửa lại cho bạn rồi nè:


(defun  C:ban2 ()
(princ "\nChon 2 duong giao nhau: ")
(setq ss1 (ssget '((0 . "line,lwpolyline"))))
(princ "\nChon cac duong muon ban: ")
(setq ss2 (ssget '((0 . "line,lwpolyline"))))
(setq p1 (cdr (assoc 10 (entget (ssname ss1 0)))))
(setq p2 (cdr (assoc 11 (entget (ssname ss1 0)))))
(setq p3 (cdr (assoc 10 (entget (ssname ss1 1)))))
(setq p4 (cdr (assoc 11 (entget (ssname ss1 1)))))
(setq gd (inters p1 p2 p3 p4))
(setq i 0)
(while (< i (sslength ss2))
(setq entname (ssname ss2 i)
pb1 (cdr (assoc 10 (entget entname)))
pb2 (cdr (assoc 11 (entget entname)))
l1 (distance pb1 gd)
l2 (distance pb2 gd)
)
(if (< l1 l2)
(progn
(setq thay (subst (cons 10 gd) (cons 10 pb1) (entget entname)))
(entmod thay)
)
(progn
(setq thay (subst (cons 11 gd) (cons 11 pb2) (entget entname)))
(entmod thay)
)
)
(setq i (1+ i))
)
)


với cả 2 lisp trên bạn thích bắn bao nhiêu đường vào điểm giao của 2 đường thẳng cũng được hết.

Hì.Không ngờ bạn sửa lại nhanh thế ^^ Tks bạn nhiều,đã ngon nghẻ rồi.bạn giúp mình làm fill luôn cả 2 đường bao bên ngoài vào trong cùng thao tác đó được không ? (Tức là 2 đường biên giao nhau bên ngoài bị thừa ra 1 tí,mình không cần phải f nó nữa ý :"> )
  • 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


#1836 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 18 September 2010 - 04:14 PM

Hề hề
Với lisp trên của mình nói là đúng 50% vì toạ độ của tâm mình không khống chế được lúc thì nó nhảy ra ngoài lúc thì nó nhảy vào trong như hình. Tiện thể bạn giải thích giùm mình luôn.
Nếu như bạn nói muốn chọn điểm bất kì trên cung đó thì phải lấy khoảng cách đểm đó tới tâm chứ ai lại lấy điểm đầu hay điểm cuối để tính bán kính. Cám ơn bạn đã gớp ý cho mình!! thank!!!
Hình đã gửi

Hề hề hề,
Chào bác Phamngoctukts,
Hình như bác quên rằng hàm (vlax-curve-getsecondderive ....) là trả về véc tơ pháp tuyến bác ạ. Đã là vecto thì ắt là nó có chiều xác định của nó rồi. Vậy bác còn băn khoăn làm chi cái vụ chiều của nó nữa nhể. Bác cứ hiểu rằng vec tơ pháp tuyến luôn hướng từ cung tròn về tâm là được bác ạ . Hay là mình nhầm nhể????
Hề hề hề....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1837 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 September 2010 - 04:41 PM

Hề hề hề,
Chào bác Phamngoctukts,
Hình như bác quên rằng hàm (vlax-curve-getsecondderive ....) là trả về véc tơ pháp tuyến bác ạ. Đã là vecto thì ắt là nó có chiều xác định của nó rồi. Vậy bác còn băn khoăn làm chi cái vụ chiều của nó nữa nhể. Bác cứ hiểu rằng vec tơ pháp tuyến luôn hướng từ cung tròn về tâm là được bác ạ . Hay là mình nhầm nhể????
Hề hề hề....

Không phải thế đâu bác Bình ạ. Cùng lisp trên nếu vẽ cung ngửa lên trên hoặc úp xuống là tâm nó bị lộn ngược ngay. Nên em cũng không hiểu chỗ này.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#1838 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 September 2010 - 04:49 PM

Hì.Không ngờ bạn sửa lại nhanh thế ^^ Tks bạn nhiều,đã ngon nghẻ rồi.bạn giúp mình làm fill luôn cả 2 đường bao bên ngoài vào trong cùng thao tác đó được không ? (Tức là 2 đường biên giao nhau bên ngoài bị thừa ra 1 tí,mình không cần phải f nó nữa ý :"> )

Của bạn đây. Vừa ý rồi nhé. Chúc bạn vui.

(defun  C:ban2 ()
(princ "\nChon 2 duong giao nhau: ")
(setq ss1 (ssget '((0 . "line,lwpolyline"))))
(setq d1 (ssname ss1 0))
(setq d2 (ssname ss1 1))
(command "fillet" d1 d2)
(princ "\nChon cac duong muon ban: ")
(setq ss2 (ssget '((0 . "line,lwpolyline"))))
(setq p1 (cdr (assoc 10 (entget (ssname ss1 0)))))
(setq p2 (cdr (assoc 11 (entget (ssname ss1 0)))))
(setq p3 (cdr (assoc 10 (entget (ssname ss1 1)))))
(setq p4 (cdr (assoc 11 (entget (ssname ss1 1)))))
(setq gd (inters p1 p2 p3 p4))
(setq i 0)
(while (< i (sslength ss2))
(setq entname (ssname ss2 i)
pb1 (cdr (assoc 10 (entget entname)))
pb2 (cdr (assoc 11 (entget entname)))
l1 (distance pb1 gd)
l2 (distance pb2 gd)
)
(if (< l1 l2)
(progn
(setq thay (subst (cons 10 gd) (cons 10 pb1) (entget entname)))
(entmod thay)
)
(progn
(setq thay (subst (cons 11 gd) (cons 11 pb2) (entget entname)))
(entmod thay)
)
)
(setq i (1+ i))
)
)

  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#1839 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 18 September 2010 - 04:52 PM

Chào bác Tue_VN
Em vừa nghĩ ra cách này để lấy toạ độ tâm của đường Pline cong mà không phải dùng code ActiveX. tuy nó Ấu trĩ nhưng em ngĩ là có thể áp dụng được.

(defun c:tam()
(setq old_echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "undo" "m")
(setq ss (ssget '((0 . "lwpolyline"))))
(command "explode" ss)
(setq ss1 (ssget "p" '((0 . "arc"))))
(setq i 0)
(setq ltam nil)
(while (< i (sslength ss1))
(setq tam (cdr (assoc 10 (entget (ssname ss1 i)))))
(setq ltam (append ltam (list tam)))
(setq i (1+ i))
)
(command "undo" "b")
(setvar "cmdecho" old_echo)
(princ (car ltam))
)

  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#1840 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 18 September 2010 - 11:33 PM

Của bạn đây. Vừa ý rồi nhé. Chúc bạn vui.

Hi bạn.Mình vừa đi xa về.Cám ơn bạn rất nhiều.Nhân tiện cho mình thắc mắc 1 chút.Mình tưởng lệnh fillet thực hiện trước vòng lặp thì ngay cả khi 2 đường biên không giao nhau nó cũng tự fillet rồi mới bắt đầu việc chuyển đầu line vào điểm giao.Nhưng mình test thấy không được.Bạn chỉ giúp mình với nhé :undecided:
  • 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