Đến nội dung


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

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


  • Please log in to reply
2851 replies to this topic

#1741 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5448 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 06 January 2014 - 09:12 PM

Có thể lòng hàm vlax-curve-getClosestPointTo  vào hàm chọn SSget không??

cám ơn bạn đã giúp đỡ

99% là không thể. Nhưng bạn có thể ssget, sau đó filter.


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#1742 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 06 January 2014 - 09:31 PM

99% là không thể. Nhưng bạn có thể ssget, sau đó filter.

Bạn viết cho mình đoạn này được không 

mình đang tìm cách nhưng không nghỉ ra được

cám ơn bạn nhiều


  • 0

#1743 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5448 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 06 January 2014 - 09:56 PM

Mai nhé, giờ U-19-VN thua hơi đau nên buồn không viết được.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#1744 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 06 January 2014 - 10:02 PM

Mai nhé, giờ U-19-VN thua hơi đau nên buồn không viết được.

Cám ơn bạn trước nhé chờ tin của bạn 

Chúc bạn mau qua nhanh nổi buồn này (Thua vẫn ngẩng cao đầu)

 

p/s: Mình thì thấy rất chi là vui vì đã có 1 đội U19 như vậy


  • 0

#1745 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5448 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 06 January 2014 - 10:51 PM

Code nhanh cho bạn đây.

ss : tập chọn các block

ent : pline

(defun Check(ss ent / i pt entx)
 (setq ss1 (ssadd))
 (repeat (setq i (sslength ss))
  (setq pt (cdr (assoc 10 (entget (setq entx (ssname ss (setq i (1- i))))))))
  (if (equal (vlax-curve-getClosestPointTo ent pt) pt 1E-8)
   (setq ss1 (ssadd entx ss1))))
 (sssetfirst nil ss1)
 ss1)  
 

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#1746 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 07 January 2014 - 12:06 PM

cho hỏi:

 code như thế nào để chọn các block bị đường pline cắt qua mà không phải zoom all/extents

Khi dùng vlisp để zoom in/out đối với mặt bằng nhỏ thì khii cảm nhận được độ trễ, khi mặt bằng lớn thid sẽ thấy độ trễ khi zoom và thấy không chuyên

 

Thanks


  • 0

#1747 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 07 January 2014 - 01:19 PM

cho hỏi:

 code như thế nào để chọn các block bị đường pline cắt qua mà không phải zoom all/extents

Khi dùng vlisp để zoom in/out đối với mặt bằng nhỏ thì khii cảm nhận được độ trễ, khi mặt bằng lớn thid sẽ thấy độ trễ khi zoom và thấy không chuyên

 

Thanks

Hề hề hề,

Xin trả lời: làm như bác DoanvanHa đã nói tức là chọn tập hợp các block rồi sau đó lọc lấy các block có giao cắt với pline.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1748 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 07 January 2014 - 05:03 PM

hề hề, đôi lúc cũng ngớ ngẩn ^^


  • 0

#1749 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5448 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 16 February 2014 - 10:22 PM

Một câu hỏi lớn:

Có ai đã từng viết lisp về bài toán Dijkstra chưa? Cho xin?

Tôi đang gặp rắc rối, dù đã viết được, nhưng tốc độ vẫn còn quá chậm.

P/S: nếu bạn đọc câu hỏi mà chưa đụng đến thì cũng xin đừng hỏi ngược lại: "Dijkstra là gì?", bởi giải thích hơi bị dài, mà cụ Gồ thì đã có.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#1750 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 February 2014 - 02:06 PM

Srr xì pam : Chưa đụng đến nhưng bác viết bằng Lisp thì quả là nan giải ^^ Xin chia sẻ sự vất vả với bác ^^


  • 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


#1751 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 17 February 2014 - 08:49 PM

Một câu hỏi lớn:

Có ai đã từng viết lisp về bài toán Dijkstra chưa? Cho xin?

Tôi đang gặp rắc rối, dù đã viết được, nhưng tốc độ vẫn còn quá chậm.

P/S: nếu bạn đọc câu hỏi mà chưa đụng đến thì cũng xin đừng hỏi ngược lại: "Dijkstra là gì?", bởi giải thích hơi bị dài, mà cụ Gồ thì đã có.

Đồ thị bao nhiêu đỉnh mà chậm hả Doan Van Ha.


  • 0

#1752 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5448 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 17 February 2014 - 09:11 PM

Đồ thị bao nhiêu đỉnh mà chậm hả Doan Van Ha.

Tầm 2000 đỉnh, chạy mất khoảng 100 giây mỗi lần. Có thể lặp nhiều lần. Đồ thị này có điều kiện ràng buộc phức tạp hơn bài toán Dijkstra mẫu vì nó kèm thêm 2 điều kiện khác:

1). Khi xét đỉnh v kề đỉnh u thì phải xét thêm đỉnh s trước đỉnh u nữa.

2). Mỗi cặp (u v) ngoài việc xét trọng số còn phụ thuộc thêm 1 đ/k ràng buộc khác.

Ngặt là bài toán này nó có quá nhiều đặc thù chuyên môn nên post lên 4R rất khó. Chỉ hy vọng ai đã có lisp về nó thì xin để nghiên cứu thêm về thuật toán làm sao để nhanh nhất có thể.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#1753 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 17 February 2014 - 10:15 PM

Thực sự bài toán Dijkstra rất mạch lạc, người ta cũng đã có thuật toán mẫu mực.

Nếu 2000 đỉnh mà 100 giây thì hơi lâu. Mình nghĩ Doan Van Ha thử cải tiến thuật toán theo hướng:

1. Nên có một bước tiền xử lý, để biến đồ thị bài toán thành ban đầu một đồ thị mới, trong đó đã bao gồm 2 điều kiện của đồ thị cũ. Để khi chạy sẽ thành thuật toán Dijkstra đơn thuần.

2. Nên sử dụng các lệnh xử lý hàng loạt trong lisp như mapcar, apply. Tránh sử dụng các vòng lặp while, foreach hay repeat.


  • 1

#1754 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5448 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 18 February 2014 - 06:59 AM

Nhờ bác Hoanh (hoặc ai đó) sửa giúp lisp này giúp với. Hình như thuật toán nó bị tệ chỗ nào đó nên khi đem vào áp dụng cho bài toán cụ thể thì chạy chậm. Trên cơ sở đó tôi sẽ biến tấu cho bài toán của mình.

;;----- Ham de Test voi vi du don gian. 
(defun C:HA( / vcl ee vv sta end )
 (setq vcl 100 vv '(0 1 2 3 4 5) ee (list
 (list (list 0 0 00) (list 0 1 07) (list 0 2 09) (list 0 3 vcl) (list 0 4 vcl) (list 0 5 14))
 (list (list 1 0 07) (list 1 1 00) (list 1 2 10) (list 1 3 15) (list 1 4 vcl) (list 1 5 vcl))
 (list (list 2 0 09) (list 2 1 10) (list 2 2 00) (list 2 3 11) (list 2 4 vcl) (list 2 5 02))
 (list (list 3 0 vcl) (list 3 1 15) (list 3 2 11) (list 3 3 00) (list 3 4 06) (list 3 5 vcl))
 (list (list 4 0 vcl) (list 4 1 vcl) (list 4 2 vcl) (list 4 3 06) (list 4 4 00) (list 4 5 09))
 (list (list 5 0 14) (list 5 1 vcl) (list 5 2 02) (list 5 3 vcl) (list 5 4 09) (list 5 5 00))))
 (setq sta (getint "\nNhap dinh khoi dau: ")) ; VD nhËp sè ®Çu tiªn lµ: 0
 (setq end (getint "\nNhap dinh ket thuc: ")) ; VD nhËp sè cuèi cïng lµ: 4
 (HA sta end vcl ee vv))
;;----- Ham tong quat.
(defun HA(sta end vcl ee vv / Canh Dinh lst lst1 u n i uv sum q1 vet)
 (defun Canh(u v ee) (caddr (nth v (nth u ee))))
 (defun Dinh(x lst) (cdr (assoc x lst)))
 (setq u sta)
 (setq lst (mapcar '(lambda(x) (cons x (if (= x u) 0 vcl))) vv)) ; G¸n gi¸ trÞ ®Ønh khëi ®Çu lµ 0, cßn l¹i lµ vcl. VD: ((0 . 0) (1 . 100) (2 . 100) (3 . 100) (4 . 100) (5 . 100))
 (while (/= u end) ; Co the thay bang "(while vv", neu tim All Path.
  (setq vv (vl-remove u vv) lst1 lst) ; Lo¹i dÇn tõng ®Ønh ®· xÐt khái vv, VD: (0 1 2 3 4 5) -> (1 2 3 4 5)
  (foreach v vv ; DuyÖt qua tõng ®Ønh cña vv.
   (if (< (setq uv (Canh u v ee)) vcl) ; Chi xet neu canh < vcl.
    (if (< (setq sum (+ (Dinh u lst) uv)) (Dinh v lst)) ; So s¸nh ®Ønh ®· cã víi tæng ®Ønh+c¹nh míi.
     (setq lst (subst (cons v sum) (assoc v lst) lst))))) ; Thay tÊt c¶ tæng cña ®Ønh v liÒn kÒ víi u, nÕu nhá h¬n.
  (if (not (equal lst lst1 1E-8)) ; So sanh, neu lst_old va lst_new khac nhau thi moi sort.
   (setq lst (vl-sort lst '(lambda(x y) (< (cdr x) (cdr y)))) ; Sort lst ®Ó s¾p xÕp l¹i vv.
         q1 (mapcar 'car lst)
         vv (vl-sort vv '(lambda(x y) (< (vl-position x q1) (vl-position y q1)))))) ; Sort vv.
  (setq u (car vv)))
 (setq lst (reverse lst)) ; Bat dau cac buoc do tim vet duong dan tu lst.
 (while (/= (caar lst) end)
  (setq lst (cdr lst)))
 (setq vet (list (car lst)))
 (foreach x (cdr lst)
  (if (equal (Canh (car x) (caar vet) ee) (- (cdar vet) (cdr x)) 1E-8)
   (setq vet (cons x vet))))
 vet)
 


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#1755 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 288 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 22 March 2014 - 11:31 AM

Khi làm việc với ActiveX các bạn lưạ chọn dùng hàm nào Vlax-get-or-create-object hay Vlax-create-object. Mình chưa thấy Vlax-get-or-create-object khác Vlax-create-object ở chỗ nào cả.

PS: Mình đang nghiên cứu cách kết nối Cad với GE thông qua ActiveX


  • 0

#1756 chinhdepchai

chinhdepchai

    Chưa sử dụng CAD

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

Đã gửi 22 April 2014 - 09:23 AM

Các bạn cho tôi hỏi về vấn đề này với.

đây là lisp vẽ tatuy mà tôi dùng rất hữu ích

nhưng có 1 điều là khi tôi muồn vẽ taluy có thông số khác với thông số của taluy ban đầu thì tôi lại  ko biết cách thay đổi thông số của taluy

xin hãy giúp tôi.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=5947&st=20
 
 
;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1
(defun nsl ()
(if (/= scale nil)
    (progn
         (setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
         (if (not (setq scaletmp (getint thongbao)))
            (setq scaletmp scale)
         )
    )
    (progn
         (setq thongbao "Ty le ban ve ? <1/1000>:")
         (if (not (setq scaletmp (getint thongbao)))
             (setq scaletmp 1000)
         )
    )
)
 
(setq scale scaletmp)
 
(setq Defaultdist (* (* scale 2) 0.002))
(if (setq tg (getreal (strcat "\nKhoang cach ky hieu ta luy <" (rtos Defaultdist 2 2) ">:")))
       (setq Defaultdist tg)
)
 
(setq chieutaluy1 1 sodoan 0)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl1 ()
(if (not ktdoantaluy1)
    (setq ktdoantaluy1 250  tg (getreal (strcat "\nChi\U+1EC1u d\U+00E0i \U+0111o\U+1EA1n ng\U+1EAFn<" (rtos ktdoantaluy1 2 2) ">:")))
)
(if tg
    (setq ktdoantaluy1 tg tg nil)
)
(if (not ktdoantaluy2)
    (setq ktdoantaluy2 500 tg (getreal (strcat "\nChi\U+1EC1u d\U+00E0i \U+0111o\U+1EA1n d\U+00E0i<" (rtos ktdoantaluy2 2 2) ">:")))
)
(if tg
    (setq ktdoantaluy2 tg tg nil)
)
(if (not khoangcachtl)
    (setq khoangcachtl 200 tg (getreal (strcat "\Kho\U+1EA3ng c\U+00E1ch gi\U+1EEFa c\U+00E1c \U+0111o\U+1EA1n<" (rtos khoangcachtl 2 2) ">:")))
)
(if tg
    (setq khoangcachtl tg tg nil)
)
(if (not sodoanngan)
    (setq sodoanngan 1 tg (getint (strcat "\nS\U+1ED1 \U+0111o\U+1EA1n ng\U+1EAFn tr\U+00EAn m\U+1ED9t \U+0111o\U+1EA1n d\U+00E0<" (rtos sodoanngan 2 0) ">:")))
)
(if tg
    (setq sodoanngan tg tg nil)
)
 
)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun PlMake (Plist) ; Create polyline entities
(entmake '((0 . "POLYLINE")))
(setq n (length Plist)
ic 0
)
(while (< ic n)
(entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
(setq ic (1+ ic)
)
)
(entmake '((0 . "SEQEND")))
 
)
 
 
;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
;;;;(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(plmake (list p1 p2))
(setq dem (1+ dem))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun xddsd (com epl kc / e0 e p dsd)
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq sodoan 0)
(setq ss (ssadd))
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
(= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "SPLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
)
 
(setq ketthuc 1)
(prompt "\nDoi tuong duoc chon khong hop le")
)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq dsd (append dsd (list (vlax-curve-getstartpoint (car ep)))))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
(setq ss (ssadd (entlast) ss))
)
)
)
(setq dem dem)
)
 
;;;==================================================
(Defun C:TL (/ ep chon lai solan chon ss tg)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "g")
;;;;(nsl)
 
(setq ep 1)
(while ep
       (setq solan 0  chieutaluy 1)
       (setq ep (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng v\U+1EBD ta luy..."))
       (if ep
            (progn
                   (nsl1)
                   (setq solan (vetaluy ep))
                   (initget "Undo Change")
                   (while
                            (setq chon (getkword "Undo/Change <enter for exit>: "))
                            (if (= chon "Undo")
                                (command "_.Undo" solan)
                            )
                            (if (= chon "Change")
                                (progn
                                        (nsl1)
                                        (setq chieutaluy -1)
                                        (command "_.Undo" solan)
                                        (setq solan (vetaluy ep))
                                )
                             )
                             (initget "Undo Change")
                    )
                    (setq blname (getstring t "\nNh\U+1EADp t\U+00EAn block m\U+1ED1n t\U+1EA1o: "))
                    (if (/= blname "")
                        (command "block" blname (list 0.0 0.0 0.0) ss "")
                    )
                    (setq ep nil)
             )
         )
)
(command "undo" "e")
(princ)
)

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...opic=5947&st=20
 
 
;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1
(defun nsl ()
(if (/= scale nil)
    (progn
         (setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
         (if (not (setq scaletmp (getint thongbao)))
            (setq scaletmp scale)
         )
    )
    (progn
         (setq thongbao "Ty le ban ve ? <1/1000>:")
         (if (not (setq scaletmp (getint thongbao)))
             (setq scaletmp 1000)
         )
    )
)
 
(setq scale scaletmp)
 
(setq Defaultdist (* (* scale 2) 0.002))
(if (setq tg (getreal (strcat "\nKhoang cach ky hieu ta luy <" (rtos Defaultdist 2 2) ">:")))
       (setq Defaultdist tg)
)
 
(setq chieutaluy1 1 sodoan 0)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl1 ()
(if (not ktdoantaluy1)
    (setq ktdoantaluy1 250  tg (getreal (strcat "\nChi\U+1EC1u d\U+00E0i \U+0111o\U+1EA1n ng\U+1EAFn<" (rtos ktdoantaluy1 2 2) ">:")))
)
(if tg
    (setq ktdoantaluy1 tg tg nil)
)
(if (not ktdoantaluy2)
    (setq ktdoantaluy2 500 tg (getreal (strcat "\nChi\U+1EC1u d\U+00E0i \U+0111o\U+1EA1n d\U+00E0i<" (rtos ktdoantaluy2 2 2) ">:")))
)
(if tg
    (setq ktdoantaluy2 tg tg nil)
)
(if (not khoangcachtl)
    (setq khoangcachtl 200 tg (getreal (strcat "\Kho\U+1EA3ng c\U+00E1ch gi\U+1EEFa c\U+00E1c \U+0111o\U+1EA1n<" (rtos khoangcachtl 2 2) ">:")))
)
(if tg
    (setq khoangcachtl tg tg nil)
)
(if (not sodoanngan)
    (setq sodoanngan 1 tg (getint (strcat "\nS\U+1ED1 \U+0111o\U+1EA1n ng\U+1EAFn tr\U+00EAn m\U+1ED9t \U+0111o\U+1EA1n d\U+00E0<" (rtos sodoanngan 2 0) ">:")))
)
(if tg
    (setq sodoanngan tg tg nil)
)
 
)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun PlMake (Plist) ; Create polyline entities
(entmake '((0 . "POLYLINE")))
(setq n (length Plist)
ic 0
)
(while (< ic n)
(entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
(setq ic (1+ ic)
)
)
(entmake '((0 . "SEQEND")))
 
)
 
 
;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
;;;;(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(plmake (list p1 p2))
(setq dem (1+ dem))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun xddsd (com epl kc / e0 e p dsd)
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq sodoan 0)
(setq ss (ssadd))
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
(= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "SPLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
)
 
(setq ketthuc 1)
(prompt "\nDoi tuong duoc chon khong hop le")
)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq dsd (append dsd (list (vlax-curve-getstartpoint (car ep)))))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
(setq ss (ssadd (entlast) ss))
)
)
)
(setq dem dem)
)
 
;;;==================================================
(Defun C:TL (/ ep chon lai solan chon ss tg)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "g")
;;;;(nsl)
 
(setq ep 1)
(while ep
       (setq solan 0  chieutaluy 1)
       (setq ep (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng v\U+1EBD ta luy..."))
       (if ep
            (progn
                   (nsl1)
                   (setq solan (vetaluy ep))
                   (initget "Undo Change")
                   (while
                            (setq chon (getkword "Undo/Change <enter for exit>: "))
                            (if (= chon "Undo")
                                (command "_.Undo" solan)
                            )
                            (if (= chon "Change")
                                (progn
                                        (nsl1)
                                        (setq chieutaluy -1)
                                        (command "_.Undo" solan)
                                        (setq solan (vetaluy ep))
                                )
                             )
                             (initget "Undo Change")
                    )
                    (setq blname (getstring t "\nNh\U+1EADp t\U+00EAn block m\U+1ED1n t\U+1EA1o: "))
                    (if (/= blname "")
                        (command "block" blname (list 0.0 0.0 0.0) ss "")
                    )
                    (setq ep nil)
             )
         )
)
(command "undo" "e")
(princ)
)
 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...opic=5947&st=20
 
 
;;;;;;;;;vtl;;;;;;;;;;;;;;;;
;Ve ta luy.lenh VTL1
(defun nsl ()
(if (/= scale nil)
    (progn
         (setq thongbao (strcat "Ty le ban ve ?, <1/" (itoa scale) ">:"))
         (if (not (setq scaletmp (getint thongbao)))
            (setq scaletmp scale)
         )
    )
    (progn
         (setq thongbao "Ty le ban ve ? <1/1000>:")
         (if (not (setq scaletmp (getint thongbao)))
             (setq scaletmp 1000)
         )
    )
)
 
(setq scale scaletmp)
 
(setq Defaultdist (* (* scale 2) 0.002))
(if (setq tg (getreal (strcat "\nKhoang cach ky hieu ta luy <" (rtos Defaultdist 2 2) ">:")))
       (setq Defaultdist tg)
)
 
(setq chieutaluy1 1 sodoan 0)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nsl1 ()
(if (not ktdoantaluy1)
    (setq ktdoantaluy1 250  tg (getreal (strcat "\nChi\U+1EC1u d\U+00E0i \U+0111o\U+1EA1n ng\U+1EAFn<" (rtos ktdoantaluy1 2 2) ">:")))
)
(if tg
    (setq ktdoantaluy1 tg tg nil)
)
(if (not ktdoantaluy2)
    (setq ktdoantaluy2 500 tg (getreal (strcat "\nChi\U+1EC1u d\U+00E0i \U+0111o\U+1EA1n d\U+00E0i<" (rtos ktdoantaluy2 2 2) ">:")))
)
(if tg
    (setq ktdoantaluy2 tg tg nil)
)
(if (not khoangcachtl)
    (setq khoangcachtl 200 tg (getreal (strcat "\Kho\U+1EA3ng c\U+00E1ch gi\U+1EEFa c\U+00E1c \U+0111o\U+1EA1n<" (rtos khoangcachtl 2 2) ">:")))
)
(if tg
    (setq khoangcachtl tg tg nil)
)
(if (not sodoanngan)
    (setq sodoanngan 1 tg (getint (strcat "\nS\U+1ED1 \U+0111o\U+1EA1n ng\U+1EAFn tr\U+00EAn m\U+1ED9t \U+0111o\U+1EA1n d\U+00E0<" (rtos sodoanngan 2 0) ">:")))
)
(if tg
    (setq sodoanngan tg tg nil)
)
 
)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun PlMake (Plist) ; Create polyline entities
(entmake '((0 . "POLYLINE")))
(setq n (length Plist)
ic 0
)
(while (< ic n)
(entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
(setq ic (1+ ic)
)
)
(entmake '((0 . "SEQEND")))
 
)
 
 
;;;----------------------------------------------------------------
(defun ve1doantaluy (p1 p2 / pvt diemcu ktdoantaluy ketthuc)
(setq pvt (+ (angle p1 p2) (* (/ pi 2) chieutaluy)))
;;;;(setq ketthuc 1)
(if (< sodoan sodoanngan)
(progn
(setq ktdoantaluy ktdoantaluy1)
(setq sodoan (1+ sodoan))
)
(progn
(setq ktdoantaluy ktdoantaluy2)
(setq sodoan 0)
)
)
(setq p2 (polar p1 pvt ktdoantaluy))
(plmake (list p1 p2))
(setq dem (1+ dem))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun xddsd (com epl kc / e0 e p dsd)
(setq e0 (entlast))
(while e0
(setq e e0)
(setq e0 (entnext e0))
)
(command com epl kc)
(setq e (entnext e))
(while e
(setq p (cdr (assoc 10 (entget e))))
(if p
(setq dsd (cons p dsd))
)
(setq e (entnext e))
)
(command "_.Undo" 1)
(setq dsd dsd)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ve ta luy cho 1 doi tuong
(Defun vetaluy (ep / le e ketthuc them dsd thutu)
(setq dem 0)
(setq sodoan 0)
(setq ss (ssadd))
(setq e (entget (car ep)))
(if (or (= (cdr (assoc 0 e)) "LWPOLYLINE")
(= (cdr (assoc 0 e)) "POLYLINE")
(= (cdr (assoc 0 e)) "SPLINE")
(= (cdr (assoc 0 e)) "LINE")
(= (cdr (assoc 0 e)) "ARC")
(= (cdr (assoc 0 e)) "CIRCLE")
)
 
(setq ketthuc 1)
(prompt "\nDoi tuong duoc chon khong hop le")
)
(if ketthuc
(progn
(setq thutu 0)
(setq dsd (xddsd "_.Measure" ep khoangcachtl))
(setq dsd (append dsd (list (vlax-curve-getstartpoint (car ep)))))
(setq p1 (car dsd))
(repeat (1- (length dsd))
(setq thutu (1+ thutu))
(setq p2 (nth thutu dsd))
(ve1doantaluy p1 p2)
(setq p1 p2)
(setq ss (ssadd (entlast) ss))
)
)
)
(setq dem dem)
)
 
;;;==================================================
(Defun C:TL (/ ep chon lai solan chon ss tg)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "undo" "g")
;;;;(nsl)
 
(setq ep 1)
(while ep
       (setq solan 0  chieutaluy 1)
       (setq ep (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng v\U+1EBD ta luy..."))
       (if ep
            (progn
                   (nsl1)
                   (setq solan (vetaluy ep))
                   (initget "Undo Change")
                   (while
                            (setq chon (getkword "Undo/Change <enter for exit>: "))
                            (if (= chon "Undo")
                                (command "_.Undo" solan)
                            )
                            (if (= chon "Change")
                                (progn
                                        (nsl1)
                                        (setq chieutaluy -1)
                                        (command "_.Undo" solan)
                                        (setq solan (vetaluy ep))
                                )
                             )
                             (initget "Undo Change")
                    )
                    (setq blname (getstring t "\nNh\U+1EADp t\U+00EAn block m\U+1ED1n t\U+1EA1o: "))
                    (if (/= blname "")
                        (command "block" blname (list 0.0 0.0 0.0) ss "")
                    )
                    (setq ep nil)
             )
         )
)
(command "undo" "e")
(princ)
)

  • 0

#1757 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 25 April 2014 - 03:38 PM

1). Image là 1 hình thì kèm gì trong đó không được, cứ gì text?

2). Bạn test lisp viết theo PA1 xem sao. Như tôi đã nói, nó có 1 nhược điểm. Còn PA2 thì đợi tí. Mà nếu bạn OK PA1 thì khỏi viết PA2.

67029_untitled3.png

LSP+DCL:

 http://www.cadviet.c.../67029_ha_1.zip

Bác Hà cho em hỏi tí bây giờ muốn có 5 cột thì làm sao em sửa hoài của Bác để sử dụng mà không được

Cám ơn Bác nhiều


  • 0

#1758 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 14 July 2014 - 05:19 PM

Mọi người cho mình hỏi tại sao trong hộp thoại của mình có trường hợp thay vì hiện là 0.7 nó lại hiện là .7.

Có phải có biến hệ thống nào liên quan đến thằng naỳ không ạ


  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#1759 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 14 July 2014 - 05:27 PM

Biến Dimzin
  • 1

#1760 ThuyLinh313

ThuyLinh313

    biết lệnh mtext

  • Members
  • PipPipPipPip
  • 288 Bài viết
Điểm đánh giá: 142 (tàm tạm)

Đã gửi 05 August 2014 - 04:35 PM

Nhờ các bạn giúp mình câu hỏi này: Làm thế nào để kiểm tra 1 tỷ lệ đang được sử dụng trong bản vẽ? Hoặc làm thế nào để lấy được danh sách tỷ lệ (scale_list) đang được sử dụng trong bản vẽ?

 

Để hiểu được định nghĩa "đang được sử dụng" mà mình nêu trong 2 câu hỏi trên bạn hãy gõ lệnh SCALELISTEDIT. Trong danh sách tỷ lệ được liệt kê ở hộp thoại hiện ra bạn sẽ thấy có một số tỷ lệ không được phép delete, do đó là các tỷ lệ đã được các đối tượng trên bản vẽ sử dụng.

Cảm ơn đã quan tâm câu hỏi của mình!


  • 0