Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Jin Yong

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

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

snowman.hms    30


(defun c:test (/ s e o i p1 p2 LM:Clockwise-p)

(vl-load-com)

;; Clockwise-p - Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented

(defun LM:Clockwise-p (p1 p2 p3)
(< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
(* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
)
)

;;-------------------------------------------------

(if (and (princ "\nSelect Bolds :")
(setq s (ssget '((0 . "CIRCLE"))))
(setq e (car (entsel "\nSelect a Line: ")))
(= "LINE" (cdr (assoc 0 (entget e))))
)
(progn
(setq p1 (cdr (assoc 10 (entget e)))
p2 (cdr (assoc 11 (entget e)))
i -1
)
(while (setq e (ssname s (setq i (1+ i))))
(setq o (vlax-ename->vla-object e))
(if (LM:Clockwise-p (vlax-get o 'center) p1 p2)
(vlax-put o 'color 1);right
(vlax-put o 'color 2);left
)
)
)
)
(princ)
)

 

  • 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
snowman.hms    30

Tue_NV có 1 câu hỏi nhìn nó có vẻ đơn giản nhưng chưa biết cách thức xử lý nó

Làm thế nào để tách kí tự "\" ra khỏi chuỗi "\037" -> Kết quả là  "037"    

Mình sử dụng hàm substr để trích chuỗi để xét thì thấy :      

Command: (substr "\037" 1 1) -> "\037". Chỉ lấy 1 ký tự mà nó ra hết

Mong các bác chỉ giáo giúp! Thanks

 

Cho em hỏi bác Tue_NV tạo ra các ký tự đó như thế nào?

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
Tr.CongSon    41

 Chuyển UCS về để 1 trục của nó trùng với Line, khi đó so sánh X hoặc Y. Chú ý khi chuyển UCS thì phải dùng hàm trans để chuyển tọa độ.

Cảm ơn anh Hạ nhé,em cũng đang đi theo hướng này 

Biết thêm được hàm trans ^^

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
Tr.CongSon    41
(defun c:test (/ s e o i p1 p2 LM:Clockwise-p)
  
  (vl-load-com)
  
  ;; Clockwise-p - Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented

  (defun LM:Clockwise-p	(p1 p2 p3)
    (< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
       (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
    )
  )
  
  ;;-------------------------------------------------
  
  (if (and (princ "\nSelect Bolds  :")
	   (setq s (ssget '((0 . "CIRCLE"))))
	   (setq e (car (entsel "\nSelect a Line:  ")))
	   (= "LINE" (cdr (assoc 0 (entget e))))
      )
    (progn
      (setq p1 (cdr (assoc 10 (entget e)))
	    p2 (cdr (assoc 11 (entget e)))
	    i  -1
      )
      (while  (setq e (ssname s (setq i (1+ i))))
	(setq o (vlax-ename->vla-object e))
	(if (LM:Clockwise-p (vlax-get o 'center) p1 p2)	    
	    (vlax-put o 'color 1);right
	    (vlax-put o 'color 2);left
	)
      )      
    )
  )
  (princ)
)

Cảm ơn Snowman nhiều,code của bạn hay thật,

Súc tích mà gọn nữa ^^

Cho mình hỏi tí: Cái hàm LM:Clockwise-p mình chửa hiểu cách thức thực hiện của nó ^^

Bạn giải thích giúp mình nhé

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
snowman.hms    30

Cảm ơn Snowman nhiều,code của bạn hay thật,

Súc tích mà gọn nữa ^^

Cho mình hỏi tí: Cái hàm LM:Clockwise-p mình chửa hiểu cách thức thực hiện của nó ^^

Bạn giải thích giúp mình nhé

LM:Clockwise-p kiểm tra xem 3 điểm p1 p2 p3 theo "chiều kim đồng hồ-hay không?" nếu đúng thì trả về true, tức là điểm p1 sẽ nằm bên phải của điểm đoạn thẳng p2-p3

Một lưu ý là khái niệm trái-phải chỉ là tương đối. nếu hiện tại 1 vật ở bên phải bạn thì khi bạn quay 180 độ thì nó lại nằm bên trái bạn :)

  • 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
Tr.CongSon    41

Thay:

(command "_.RECTANGLE")

Bằng:

(command "_.RECTANGLE" (setq p1 (getpoint "\nP1: ")) (getcorner p1 "\nP2: "))

Em cảm ơn a Hạ nhé.

Em tìm hiểu mấy ngày nay và đã thấy lỗi ,không phải do Command  mà do chỗ set biến cục bộ cho Lisp ^.Tại dòng này ạ

(defun c:CM (/ *error* cla ent-last iferror k lay olderr os pause r ve vec)

Dư có mỗi từ này mà Lisp bị lỗi ^^

 Pause ở Lisp này không phải là biến mà nó giống như 1 lệnh trong Lisp dùng để dung chương trình đợi tín hiệu nhập từ chuột hoặc bàn phím ^

Do đó mình sét nó vào biến thì--->Lisp chạy Sai

Anh em khi dùng (command Pause") nhớ chú ý khỏi bị lỗi nhé!

Thân Ái!

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
khoaspkt    0

Không biết đặt câu hỏi ngớ ngẩn này ở đâu nên đành viết đại ra đây, mong mọi người giúp.

- Mình đang viết cái lisp mà kẹt ở giải thuật. Như thế này. Có 1 góc tạo bởi 3 điểm, A(x1,y1), B(x2,y2), C(x3,y3). Viết phương trình đường thẳng của đường phân giác của góc B. Các số x1, x2,x3,y1,y2,y3 đã biết.

- Mình đọc bài giải trên mạng mà ko hiểu do quên nhiều kiến thức quá. Mong mọi người giải cụ thể giúp. 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
Doan Van Ha    2.676

Tặng bạn cái này. Tôi viết lâu rồi và đã post lên Caviet nhưng giờ quên link nên post lại. Vẽ đủ thứ trong tam giác luôn.

 

;----- Ve cac duong dac biet trong tam giac.
;Doan Van Ha CADViet.com
(defun C:HA( / p11 p22 p33 pg12 pg23 pg31)
 (or cal (arxload "geomcal"))
 (command "undo" "begin")
 (setq p1 (getpoint "\nChon dinh thu 1 cua tam giac: ")
           p2 (getpoint "\nChon dinh thu 2 cua tam giac: ")
           p3 (getpoint "\nChon dinh thu 3 cua tam giac: "))
 (if (not (3DTH p1 p2 p3))
  (progn 
   (setq p11 (inters p1 (polar p1 (acet-dtor (- (cal "ang(p1,p2)") (/ (cal "ang(p1,p3,p2)") 2))) 1) p2 p3 nil)
             p22 (inters p2 (polar p2 (acet-dtor (- (cal "ang(p2,p3)") (/ (cal "ang(p2,p1,p3)") 2))) 1) p3 p1 nil)
             p33 (inters p3 (polar p3 (acet-dtor (- (cal "ang(p3,p1)") (/ (cal "ang(p3,p2,p1)") 2))) 1) p1 p2 nil)
             pg12 (acet-geom-midpoint p1 p2)
             pg23 (acet-geom-midpoint p2 p3)
             pg31 (acet-geom-midpoint p3 p1))
   (acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
   (initget "1 2 3 4 5 6")
   (setq kieu (getkword "\nChon kieu ve: 1.Duong cao/2.Phan giac/3.Trung tuyen/4.Trung truc/5.Noi tiep/6.Ngoai tiep: "))
   (cond ((= kieu "1") (VDC p1 p2 p3))
              ((= kieu "2") (VPG p1 p2 p3))
              ((= kieu "3") (VTT p1 p2 p3))
              ((= kieu "4") (VTTR p1 p2 p3))
              ((= kieu "5") (VDTNT p1 p2 p3))
              ((= kieu "6") (VDTNGT p1 p2 p3)))
   (acet-sysvar-restore)
   (command "undo" "end"))
  (alert "3 diem nay thang hang, khong lam gi duoc nua dau!"))
 (princ))
;----- Ve 3 duong trung truc.
(defun VTTR(p1 p2 p3)
 (command "xline" pg12 (polar pg12 (+ (acet-dtor (cal "ang(p1,p2)")) (/ pi 2)) 1) ""
                    "xline" pg23 (polar pg23 (+ (acet-dtor (cal "ang(p2,p3)")) (/ pi 2)) 1) ""
                    "xline" pg31 (polar pg31 (+ (acet-dtor (cal "ang(p3,p1)")) (/ pi 2)) 1) ""))
;----- Ve 3 duong cao.
(defun VDC(p1 p2 p3)
 (command "line" p1 (HA p1 p2 p3) "" "line" p2 (HA p2 p3 p1) "" "line" p3 (HA p3 p1 p2) ""))
;----- Ve 3 duong phan giac.
(defun VPG(p1 p2 p3)
 (command "line" p1 p11 "" "line" p2 p22 "" "line" p3 p33 ""))
;----- Ve 3 duong trung tuyen.
(defun VTT(p1 p2 p3)
 (command "line" p1 pg23 "" "line" p2 pg31 "" "line" p3 pg12 ""))
;----- Ve duong tron noi tiep.
(defun VDTNT(p1 p2 p3)
 (command "circle" (inters p1 p11 p2 p22 nil) (HA (inters p1 p11 p2 p22 nil) p1 p2)))
;----- Ve duong tron ngoai tiep.
(defun VDTNGT(p1 p2 p3)
 (command "circle" "3p" p1 p2 p3))
;----- 
(defun HA(pt p1 p2 / vt pt1) (setq vt (cal "nor(p1,p2)")) (setq pt1 (cal "pt+vt")) (cal "ill(pt,pt1,p1,p2)"))
;----- 
(defun 3DTH ( p1 p2 p3 ) ((lambda ( a b c ) (or (equal (+ a b) c 1e-8) (equal (+ b c) a 1e-8) (equal (+ c a) b 1e-8))) (distance p1 p2) (distance p2 p3) (distance p1 p3)))

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
khoaspkt    0

 

Tặng bạn cái này. Tôi viết lâu rồi và đã post lên Caviet nhưng giờ quên link nên post lại. Vẽ đủ thứ trong tam giác luôn.

;----- Ve cac duong dac biet trong tam giac.
;Doan Van Ha CADViet.com
(defun C:HA( / p11 p22 p33 pg12 pg23 pg31)
 (or cal (arxload "geomcal"))
 (command "undo" "begin")
 (setq p1 (getpoint "\nChon dinh thu 1 cua tam giac: ")
           p2 (getpoint "\nChon dinh thu 2 cua tam giac: ")
           p3 (getpoint "\nChon dinh thu 3 cua tam giac: "))
 (if (not (3DTH p1 p2 p3))
  (progn 
   (setq p11 (inters p1 (polar p1 (acet-dtor (- (cal "ang(p1,p2)") (/ (cal "ang(p1,p3,p2)") 2))) 1) p2 p3 nil)
             p22 (inters p2 (polar p2 (acet-dtor (- (cal "ang(p2,p3)") (/ (cal "ang(p2,p1,p3)") 2))) 1) p3 p1 nil)
             p33 (inters p3 (polar p3 (acet-dtor (- (cal "ang(p3,p1)") (/ (cal "ang(p3,p2,p1)") 2))) 1) p1 p2 nil)
             pg12 (acet-geom-midpoint p1 p2)
             pg23 (acet-geom-midpoint p2 p3)
             pg31 (acet-geom-midpoint p3 p1))
   (acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
   (initget "1 2 3 4 5 6")
   (setq kieu (getkword "\nChon kieu ve: 1.Duong cao/2.Phan giac/3.Trung tuyen/4.Trung truc/5.Noi tiep/6.Ngoai tiep: "))
   (cond ((= kieu "1") (VDC p1 p2 p3))
              ((= kieu "2") (VPG p1 p2 p3))
              ((= kieu "3") (VTT p1 p2 p3))
              ((= kieu "4") (VTTR p1 p2 p3))
              ((= kieu "5") (VDTNT p1 p2 p3))
              ((= kieu "6") (VDTNGT p1 p2 p3)))
   (acet-sysvar-restore)
   (command "undo" "end"))
  (alert "3 diem nay thang hang, khong lam gi duoc nua dau!"))
 (princ))
;----- Ve 3 duong trung truc.
(defun VTTR(p1 p2 p3)
 (command "xline" pg12 (polar pg12 (+ (acet-dtor (cal "ang(p1,p2)")) (/ pi 2)) 1) ""
                    "xline" pg23 (polar pg23 (+ (acet-dtor (cal "ang(p2,p3)")) (/ pi 2)) 1) ""
                    "xline" pg31 (polar pg31 (+ (acet-dtor (cal "ang(p3,p1)")) (/ pi 2)) 1) ""))
;----- Ve 3 duong cao.
(defun VDC(p1 p2 p3)
 (command "line" p1 (HA p1 p2 p3) "" "line" p2 (HA p2 p3 p1) "" "line" p3 (HA p3 p1 p2) ""))
;----- Ve 3 duong phan giac.
(defun VPG(p1 p2 p3)
 (command "line" p1 p11 "" "line" p2 p22 "" "line" p3 p33 ""))
;----- Ve 3 duong trung tuyen.
(defun VTT(p1 p2 p3)
 (command "line" p1 pg23 "" "line" p2 pg31 "" "line" p3 pg12 ""))
;----- Ve duong tron noi tiep.
(defun VDTNT(p1 p2 p3)
 (command "circle" (inters p1 p11 p2 p22 nil) (HA (inters p1 p11 p2 p22 nil) p1 p2)))
;----- Ve duong tron ngoai tiep.
(defun VDTNGT(p1 p2 p3)
 (command "circle" "3p" p1 p2 p3))
;----- 
(defun HA(pt p1 p2 / vt pt1) (setq vt (cal "nor(p1,p2)")) (setq pt1 (cal "pt+vt")) (cal "ill(pt,pt1,p1,p2)"))
;----- 
(defun 3DTH ( p1 p2 p3 ) ((lambda ( a b c ) (or (equal (+ a b) c 1e-8) (equal (+ b c) a 1e-8) (equal (+ c a) b 1e-8))) (distance p1 p2) (distance p2 p3) (distance p1 p3)))
Cảm ơn bạn đã quan tâm. Mình xem qua cái lisp, mình chưa hiểu chỗ xác định cái điểm p12,23,31,11,22,33. Ý là lisp thì ok rồi, mình không nghĩ là vẽ tùm lum đường vậy mà có mấy dòng là ok, quá hay. Mình cần cái thuật toán để áp dụng cho trường hợp của mình. Cụ thể là mình xác định 1 điểm trên đường phân giác của 1 góc và cách tâm góc 1 khoảng xác định.

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
duy782006    1.373

Mình đang cần đoạn lisp làm việc như sau:

Kích vào 1 đối tượng att trong Block,

-Kết quả là Tag và Value của att đó.

-Đồng thời mình muốn chọn cả cái block chứa cái att đó thành đối tượng.

Bạn nào giúp mình với! Cám ơn.

 

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
Doan Van Ha    2.676

Chắc là thế này?

(setq lst (entget (car (nentsel))))

(setq tag (cdr (assoc 2 lst)))

(setq val (cdr (assoc 1 lst)))

(setq ent (cdr (assoc 330 lst)))

(sssetfirst nil (ssadd ent))

  • 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
duy782006    1.373

Mình có đoạn lisp tạo block chứa đối tượng ATT như sau:

(defun c:tbl ()
  (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (66 . 1) (2 . "bltt") (10 0.0 0.0 0.0) (70 . 0)))
  (entmake '((0 . "CIRCLE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbCircle") (10 300.1373959146440 300.1370228494052 0.0) (40 . 300.1373959146440)))
  (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbText") (10 88.22203116700306 125.4390094483963 0.0) (40 . 350.0) (1 . "ttt") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "DIM") (71 . 0) (72 . 1) (11 303.1941760137997 15.27187852917632 0.0) (100 . "AcDbAttributeDefinition") (3 . "tt") (2 . "T") (70 . 8) (73 . 0) (74 . 1) (280 . 1)))
  (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
  (princ)
) 

Vấn đề là nó tạo được block nhưng ko hiển thị giá trị ATT trong đó. Khi explode nó ra thì ATT lại hiện ra. Bác nào có cách khắc phục giúp mình với! 

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    97

Mình có đoạn lisp tạo block chứa đối tượng ATT như sau:

(defun c:tbl ()
  (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (66 . 1) (2 . "bltt") (10 0.0 0.0 0.0) (70 . 0)))
  (entmake '((0 . "CIRCLE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbCircle") (10 300.1373959146440 300.1370228494052 0.0) (40 . 300.1373959146440)))
  (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbText") (10 88.22203116700306 125.4390094483963 0.0) (40 . 350.0) (1 . "ttt") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "DIM") (71 . 0) (72 . 1) (11 303.1941760137997 15.27187852917632 0.0) (100 . "AcDbAttributeDefinition") (3 . "tt") (2 . "T") (70 . 8) (73 . 0) (74 . 1) (280 . 1)))
  (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
  (princ)
) 

Vấn đề là nó tạo được block nhưng ko hiển thị giá trị ATT trong đó. Khi explode nó ra thì ATT lại hiện ra. Bác nào có cách khắc phục giúp mình với! 

(entmake '((0 . "BLOCK")

         (100 . "AcDbEntity")

         (67 . 0)

         (8 . "0")

         (100 . "AcDbBlockReference")

         (66 . 1)

         (2 . "bltt")

         (10 0.0 0.0 0.0)

         (70 . 2)

        )

  )

  • 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
Tr.CongSon    41

Chào các anh chị,

Em có 4 điểm là 4 đỉnh của hình chữ nhật,em muốn tạo pline (gồm line và arc) qua 4 đỉnh của HCN,sao cho 2 cạnh ngắn của HCN là cung tròn ARC

Em làm (command "pline") thì được nhưng dùng entmake thì không biết tạo như thế nào...

Anh chị có thể code cho em 1 đoạn tham khảo được ko ạ

Em cảm ơn,

(entmake (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")

.....
.....

)

 Do công ty không cho Up file nên mong mọi người thông cảm.

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
Doan Van Ha    2.676

Khi entmake pline có cung tròn thì rất phức tạp. Trường hợp của bạn chỉ có 2 arc thì cách làm như này là tiện nhất:

Vẽ Pline thỏa mãn >> lấy entget nó >> từ đó suy ra cách entmake.

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
quocmanh04tt    385

@ Bác Doan Van Ha: Em nghĩ cũng không đến nỗi phức tạp lắm đâu...! Đây là Entmake PL có ARC:

(defun mpline:bulges (point-list bulge-list)

(entmake (apply (function append)

(cons (list '(0 . "LWPOLYLINE")

'(100 . "AcDbEntity")

'(67 . 0)

'(410 . "Model")

(cons 43 0)

'(100 . "AcDbPolyline")

(cons 90 (length point-list))

'(70 . 0))

(mapcar (function list)

(mapcar (function (lambda (a) (cons 10 a))) point-list)

(mapcar (function (lambda ( B) (cons 42 B))) bulge-list))))))

Trong đó bulge-list giá trị tại các point, được tính (như hình kèm theo) = tan (góc chắn cung / 4).

141736_bulge2arc.png

  • 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
gia_bach    1.442

Chào các anh chị,

Em có 4 điểm là 4 đỉnh của hình chữ nhật,em muốn tạo pline (gồm line và arc) qua 4 đỉnh của HCN,sao cho 2 cạnh ngắn của HCN là cung tròn ARC

Em làm (command "pline") thì được nhưng dùng entmake thì không biết tạo như thế nào...

Anh chị có thể code cho em 1 đoạn tham khảo được ko ạ

Em cảm ơn,

(entmake (list

(cons 0 "LWPOLYLINE")

(cons 100 "AcDbEntity")

(cons 100 "AcDbPolyline")

 

.....

.....

 

)

 Do công ty không cho Up file nên mong mọi người thông cảm.

Tham khảo: 

(defun c:addRecArc(/ pt)
  (defun drawRecArc(pt delX delY / pt1 lst-pt lst-bul lst-w)
    (defun 3Dto2D(pt) (list (car pt) (cadr pt)))
    (setq pt1 (polar pt 0 delX)
	  lst-pt (list (3Dto2D pt) (3Dto2D pt1)
		       (3Dto2D (polar pt1 (/ pi 2) delY))
		       (3Dto2D (polar pt (/ pi 2) delY)) )
	  lst-bul (list 0 1 0 1) lst-w (list 0 0 0 0))
    (entmakex
	(apply
	  (function append)
	  (cons
	    (list
	      '(0 . "LWPOLYLINE")
	      '(100 . "AcDbEntity")
	      '(67 . 0)
	      '(100 . "AcDbPolyline")
	      (cons 90 (length lst-pt))
	      '(70 . 1)	      )
	    (mapcar
	      (function list)
	      (mapcar (function (lambda (a) (cons 10 a))) lst-pt)
;;;	      (mapcar (function (lambda (a) (cons 40 a))) lst-w)
;;;	      (mapcar (function (lambda (a) (cons 41 a))) lst-w)
	      (mapcar (function (lambda (a) (cons 42 a))) lst-bul) )  ) )) )
  (setq pt (getpoint "\nInsert point: "))
  (drawRecArc pt 1000 500))
  • 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
quocmanh04tt    385

Point nào thì bulge ấy. Đây là đoạn code vẽ thép đai mặt cắt em mới làm:

(defun c:vtd (/ bv r hdai wdai hdam pdv wdam pt0 pt1 pt10 pt11 pt12 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 ptg tan nad:mpline:bulges ra deg)

(defun ra (g) (/ (* g pi) 180))

(defun deg (so) (/ (* 180 so) pi))

(defun mpline:bulges (point-list bulge-list)

(entmake (apply (function append)

(cons (list '(0 . "LWPOLYLINE")

'(100 . "AcDbEntity")

'(67 . 0)

'(410 . "Model")

(cons 43 0)

(if (tblsearch "LAYER" "THEP")

(cons 8 "THEP")

(cons 8 (getvar "Clayer")))

'(100 . "AcDbPolyline")

(cons 90 (length point-list))

'(70 . 0))

(mapcar (function list)

(mapcar (function (lambda (a) (cons 10 a))) point-list)

(mapcar (function (lambda ( B) (cons 42 B))) bulge-list))))))

(defun Polar3 (Pnt KC1 KC2 / P1) (setq P1 (list (+ (car Pnt) KC1) (+ (cadr Pnt) KC2))))

(defun tan (f) (/ (sin f) (cos f)))

(if (not tyle_ve_dai_dam-0)

(setq tyle_ve_dai_dam-0 5))

(setq tyle (getreal (strcat "\nTy le mat cat dam da ve <" (rtos tyle_ve_dai_dam-0) ">: ")))

(if (not tyle)

(setq tyle tyle_ve_dai_dam-0)

(setq tyle_ve_dai_dam-0 tyle))

(setq bv (* 20 tyle)

R (* 10 tyle))

(if (and (setq ptg (getpoint "\nDiem goc mc dam: ")) (setq pt0 (getcorner ptg "\nDiem goc doi dien: ")))

(progn (setq pdv (list (min (car ptg) (car pt0)) (min (cadr ptg) (cadr pt0))))

(setq wdai (- (- (car pt0) (car ptg)) (* 2 bv))

hdai (- (- (cadr pt0) (cadr ptg)) (* 2 bv))

wdam (abs (- (car pt0) (car ptg)))

hdam (abs (- (cadr pt0) (cadr ptg)))

pt10 (Polar3 pdv (- wdam (+ bv r)) bv)

pt2 (polar pt10 (* pi 0.875) (* 2 r (sin (/ pi 8))))

pt1 (polar pt2 (* pi 0.7) bv)

pt3 (Polar3 pt10 r r)

pt4 (Polar3 pt3 0 (- hdam (* (+ bv r) 2)))

pt5 (Polar3 pt4 (* r -1) r)

pt6 (Polar3 pt5 (* (- wdam (* (+ bv r) 2)) -1) 0)

pt7 (polar3 pt6 (* r -1) (* r -1))

pt8 (Polar3 pt7 0 (* (- hdam (* (+ bv r) 2)) -1))

pt9 (polar3 pt8 (* r 1) (* r -1))

pt11 (polar pt3 (* pi 0.625) (* 2 r (sin (/ pi 8))))

pt12 (polar pt11 (ra 144) bv))

(mpline:bulges (list pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12)

(list 0

(tan (* (/ pi 16) 3))

0

(tan (/ pi 8))

0

(tan (/ pi 8))

0

(tan (/ pi 8))

0

(tan (* (/ pi 16) 3))

0

0))))

(princ))

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
Tr.CongSon    41

 

Tham khảo: 

(defun c:addRecArc(/ pt)
  (defun drawRecArc(pt delX delY / pt1 lst-pt lst-bul lst-w)
    (defun 3Dto2D(pt) (list (car pt) (cadr pt)))
    (setq pt1 (polar pt 0 delX)
	  lst-pt (list (3Dto2D pt) (3Dto2D pt1)
		       (3Dto2D (polar pt1 (/ pi 2) delY))
		       (3Dto2D (polar pt (/ pi 2) delY)) )
	  lst-bul (list 0 1 0 1) lst-w (list 0 0 0 0))
    (entmakex
	(apply
	  (function append)
	  (cons
	    (list
	      '(0 . "LWPOLYLINE")
	      '(100 . "AcDbEntity")
	      '(67 . 0)
	      '(100 . "AcDbPolyline")
	      (cons 90 (length lst-pt))
	      '(70 . 1)	      )
	    (mapcar
	      (function list)
	      (mapcar (function (lambda (a) (cons 10 a))) lst-pt)
;;;	      (mapcar (function (lambda (a) (cons 40 a))) lst-w)
;;;	      (mapcar (function (lambda (a) (cons 41 a))) lst-w)
	      (mapcar (function (lambda (a) (cons 42 a))) lst-bul) )  ) )) )
  (setq pt (getpoint "\nInsert point: "))
  (drawRecArc pt 1000 500))

Em cảm ơn,đúng ý em rồi ạ

Anh cho em hỏi :cái lst-w  trong code trên sao không sử dung  (hay mã 40,41 này không cần thiết) ,còn  mã dxf ( 42 . 1) là quy định cái đoạn pline là arc đúng ko ạ (nêu (42 . 0) là line ,???.Anh chỉ thêm mã dxf nào chỉnh cái đổ rộng của pline ko anh?

Cái này em tìm trong help mà không thấy ,.

Như vậy đoạn code em làm thế này cũng được a hì. (chưa chỉnh được width)

 

(entmake

(append

(list (cons 0 "LWPOLYLINE")

(cons 100 "AcDbEntity")

(cons 100 "AcDbPolyline")

(cons 8 "2")

 (cons 90 4);;Length listpoint

(cons 70 1)

)

(mapcar '(lambda (p) (cons 10 p)) (list p1 p2))

(list (cons 42 1))

(mapcar '(lambda (p) (cons 10 p)) (list p3 p4))

(list (cons 42 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
gia_bach    1.442

Em cảm ơn,đúng ý em rồi ạ

Anh cho em hỏi :cái lst-w  trong code trên sao không sử dung  (hay mã 40,41 này không cần thiết) ,còn  mã dxf ( 42 . 1) là quy định cái đoạn pline là arc đúng ko ạ (nêu (42 . 0) là line ,???.Anh chỉ thêm mã dxf nào chỉnh cái đổ rộng của pline ko anh?

Cái này em tìm trong help mà không thấy ,.

Như vậy đoạn code em làm thế này cũng được a hì. (chưa chỉnh được width)

 

 

DXF 42 còn gọi là Bulge như bài viết cùa QuocManh ....

DXF 40,41 qui định chiều rộng của Pline

Gửi lại Lisp có set chiều rông :

(defun c:addRecArc(/ pt)
  (defun drawRecArc(pt delX delY / pt1 lst-pt lst-bul lst-w)
    (defun 3Dto2D(pt) (list (car pt) (cadr pt)))
    (setq pt1 (polar pt 0 delX)
	  lst-pt (list (3Dto2D pt) (3Dto2D pt1)
		       (3Dto2D (polar pt1 (/ pi 2) delY))
		       (3Dto2D (polar pt (/ pi 2) delY)) )
	  lst-bul (list 0 1 0 1) lst-w (list 0 25 0 25))
    (entmakex
	(apply
	  (function append)
	  (cons
	    (list
	      '(0 . "LWPOLYLINE")
	      '(100 . "AcDbEntity")
	      '(67 . 0)
	      '(100 . "AcDbPolyline")
	      (cons 90 (length lst-pt))
	      '(70 . 1))
	    (mapcar
	      (function list)
	      (mapcar (function (lambda (a) (cons 10 a))) lst-pt)
	      (mapcar (function (lambda (a) (cons 40 a))) lst-w)
	      (mapcar (function (lambda (a) (cons 41 a))) (reverse lst-w))
	      (mapcar (function (lambda (a) (cons 42 a))) lst-bul) )  ) )) )
  (setq pt (getpoint "\nInsert point: "))
  (drawRecArc pt 1000 500))
  • 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

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


×