Chuyển đến nội dung
Diễn đàn CADViet

Thaistreetz

Nhà quảng cáo
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    905

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    30

Bài đăng được đăng bởi Thaistreetz

  1. Đã đăng · Trả lời báo cáo

    mình đã sửa lại để chơi đuợc cả hàng lẫn cột đây. post lâu lắm rồi mới thấy có bạn ý kiến nên chắc cũng ít người có nhu cầu này nhỉ.

    (defun c:srt (/ DXF MakeText HANG I LAP LSTKQ PT0 PTI SS1 SS2 SS3 SSN SSN3 TBS1 TBS2 TBS3)
(defun DXF (code en)	(cdr (assoc code (entget en))))
(defun entmod-en (code value en / RES)
(setq RES (entget en '("*")))
(entmod (subst (cons code value) (assoc code RES) RES)))
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst); Ang: Radial
(setq Lst (list '(0 . "TEXT")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 62 (if Color Color 256))
(cons 10 point)
(cons 40 Height)
(cons 1 string)
(if Ang (cons 50 Ang))
(cons 7 (if Style Style (getvar "Textstyle")))
(cons -3 (if xdata (list xdata) nil)))
justify (strcase justify))
(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))	
((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
(entmakex Lst));endmaketext
(setq pheptinh (cond (pheptinh) ("Cong")))
(initget "Cong Tru Nhan CHia")
(setq pheptinh (cond ((getkword (strcat "\nchon phep tinh: [Cong/Tru/Nhan/CHia/] <" pheptinh ">: "))) (pheptinh)))
(prompt "\nChon Hang-Cot so thu nhat..")
(if (setq SS1 (ssget '((0 . "TEXT"))))
(progn (prompt "Chon Hang-Cot so thu hai..")
(if (setq SS2 (ssget '((0 . "TEXT"))))
(progn
(Setq TBS1 (ACET-GEOM-SS-EXTENTS-FAST SS1) SS1 (acet-ss-to-list SS1)
TBS2 (ACET-GEOM-SS-EXTENTS-FAST SS2) SS2 (acet-ss-to-list SS2))
(if (> (abs(- (car (car TBS1)) (car (cadr TBS1)))) (abs(- (cadr (car TBS1)) (cadr (cadr TBS1)))))
(setq Hang T
SS1 (vl-sort SS1 '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))
(setq Hang nil
SS1 (vl-sort SS1 '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))))
(if (> (abs(- (car (car TBS2)) (car (cadr TBS2)))) (abs(- (cadr (car TBS2)) (cadr (cadr TBS2)))))
(setq SS2 (vl-sort SS2 '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))
(setq SS2 (vl-sort SS2 '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))))
(if (> (length SS1) (length SS2)) (setq lap (length SS1) i 0) (setq lap (length SS2) i 0))
(setq LstKQ '())
(if (setq PT0 (getpoint (strcat "\nchon diem dat " (if Hang "hang" "cot") " ket qua. Enter de ghi va Hang-Cot text khac")))
(progn (vl-cmdf "ucs" "w")
(repeat lap
(setq SSn (nth i SS1))
(maketext
(if (= hang nil)
(setq PTi (list (car PT0) (cadr (DXF 10 SSn))))
(setq PTi (list (car (DXF 10 SSn)) (cadr PT0))))
(cond ((eq pheptinh "Cong")	(rtos (+ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Tru")	(rtos (- (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Nhan")	(rtos (* (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "CHia")	(rtos (/ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2)))
(DXF 40 SSn) 0 "R"(DXF 7 SSn) (DXF 8 SSn) nil nil)
(setq  i (1+ i)))
(vl-cmdf "ucs" "p"))
(progn
(prompt "\nChon Hang hoac Cot text de ghi ket qua")
(if (setq SS3 (ssget '((0 . "TEXT"))))
(setq TBS3 (ACET-GEOM-SS-EXTENTS-FAST SS3)
SS3 (acet-ss-to-list SS3))
(EXIT))
(if (> (abs(- (car (car TBS3)) (car (cadr TBS3)))) (abs(- (cadr (car TBS3)) (cadr (cadr TBS3)))))
(setq SS3 (vl-sort SS3 '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))))
(setq SS3 (vl-sort SS3 '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2))))))))
(vl-cmdf "undo" "begin")
(repeat lap
(setq SSn (nth i SS1))
(if (setq SSn3 (nth i SS3))
(entmod-en 1
(cond ((eq pheptinh "Cong")	(rtos (+ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Tru")	(rtos (- (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "Nhan")	(rtos (* (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))
((eq pheptinh "CHia")	(rtos (/ (atof (DXF 1 SSn)) (atof (DXF 1 (nth i SS2)))) 2 2))) SSn3)
(progn
(alert (strcat "tap hop text khong du de ghi ket qua. Thieu "(rtos (- lap i) 2 0)" text"))
(vl-cmdf "undo" "end")
(EXIT)))
(setq  i (1+ i)))
(vl-cmdf "undo" "end")));if
);progn
)));if
(princ)
);end

    • Vote tăng 4

  3. Đã đăng · Trả lời báo cáo

    bạn copy đoạn này dán vào đít của code trên. Dùng lệnh RV

    (defun c:rv (/ EN)
(if (setq EN (car(entsel "- Chon duong Polyline de doi chieu")))
(cond
((= "POLYLINE" (cdr(assoc 0 (entget EN)))) (revhwpline EN) (prompt " - OK!"))
((= "LWPOLYLINE" (cdr(assoc 0 (entget EN)))) (revlwpline EN) (prompt " - OK!"))
(t (prompt "\n Doi tuong khong phai Polyline"))
))
(princ))

    • Vote tăng 1

  5. Đã đăng · Trả lời báo cáo

    Mình nhớ có lần mình đã post 1 lisp đổi chiều hầu hết mọi đối tượng có thể đổi chiều: *LINE, Arc, circle, ellipse, *Text, hatch, gradient... nhưng quên mất post ở đâu rồi.

    đây là 2 hàm đổi chiều LWpolyline và Polyline đầu xuôi đuôi cũng lọt. Chỉ đổi chiều, mọi thông tin khác của đối tuợng đuợc bảo toàn

    ;LWPOLYLINE
(defun revlwpline (e / footer done vertices header flag)
 ;reverse lightweight polyline
 (foreach item (reverse (entget e))
   (cond
     ((not done)
       (cond
         ((= (car item) 40)
           (setq footer (cons (cons 41 (cdr item)) footer)      ;swap width
                 done t
           )
         )
         ((= (car item) 41)
           (setq footer (cons (cons 40 (cdr item)) footer))     ;swap width
         )
         ((= (car item) 42)
           (setq footer (cons (cons 42 (- (cdr item))) footer)) ;negate bulge
         )
         ((= (car item) 210)
           (setq footer (cons item footer))
         )
       )
     )
     ((= (car item) 10)
       (setq vertices (cons item vertices))
     )
     ((= (car item) 40)
       (setq vertices (cons (cons 41 (cdr item)) vertices))     ;swap width
     )
     ((= (car item) 41)
       (setq vertices (cons (cons 40 (cdr item)) vertices))     ;swap width
     )
     ((= (car item) 42)
       (setq vertices (cons (cons 42 (- (cdr item))) vertices)) ;negate bulge
     )
     (t (setq header (cons item header)))
   )
 )
 (setq flag (assoc 70 header))
 (if (< (cdr flag) 128)                 ;turn on linetype generation
   (setq header (subst (cons 70 (+ (cdr flag) 128)) flag header))
 )
 (entmod (append header (reverse vertices) footer))
)
;------------------------------------------------------------------------------
;POLYLINE
(defun revhwpline (e / oldname old ent1 buldge end start ent tangent radians
                      vertex vertices flag)
 ;reverse heavyweight polyline
 (setq oldname  e
       old   (entget oldname)
       e     (entnext e)
       ent1  (entget e)                 ;get first vertex
       bulge (cdr (assoc 42 ent1))
       end   (cdr (assoc 41 ent1))
       start (cdr (assoc 40 ent1))
       e     (entnext e)
       ent   (entget e)                 ;get second vertex
 )
 (while (= (cdr (assoc 0 ent)) "VERTEX")
   (if (= (logand (cdr (assoc 70 ent)) 2) 2)
     (setq tangent (assoc 50 ent)
           radians (- (cdr tangent) pi) ;reverse tangent
           ent     (subst (cons 50 radians) tangent ent)
     )
   )
   (setq vertex   (subst (cons 42 (- bulge))(assoc 42 ent) ent)    ;negate bulge
         vertex   (subst (cons 41 start)    (assoc 41 ent) vertex) ;swap width
         vertex   (subst (cons 40 end)      (assoc 40 ent) vertex) ;swap width
         bulge    (cdr  (assoc 42 ent))
         end      (cdr  (assoc 41 ent))
         start    (cdr  (assoc 40 ent))
         vertices (cons vertex vertices)
         e        (entnext e)
         ent      (entget e)            ;get next vertex or seqend
   )
 )
 (setq flag (assoc 70 old))
 (if (< (cdr flag) 128)                 ;turn on linetype generation
   (setq old (subst (cons 70 (+ (cdr flag) 128)) flag old))
 )
 (entmake old)                          ;make new polyline
 (foreach ent vertices (entmake ent))   ;make new vertices
 (if (= (logand (cdr (assoc 70 ent1)) 2) 2)
   (setq tangent (assoc 50 ent1)
         radians (- (cdr tangent) pi)   ;reverse tangent
         ent1    (subst (cons 50 radians) tangent ent1)
   )
 )
 (setq ent1 (subst (cons 42 (- bulge))(assoc 42 ent1) ent1) ;negate bulge
       ent1 (subst (cons 41 start)    (assoc 41 ent1) ent1) ;swap width
       ent1 (subst (cons 40 end)      (assoc 40 ent1) ent1) ;swap width
 )
 (entmake ent1)                         ;make last new vertex
 (entmake ent)                          ;make new seqend
 (entdel oldname)                       ;delete old polyline
)

    • Vote tăng 1

  6. Đã đăng · Trả lời báo cáo

    câu hỏi này post vào đây sẽ là không đúng chỗ. nhưng vì muốn ai đó có trách nhiệm với box autolisp này dễ dàng đọc được nó nên mình quyết định post.

    Câu hỏi là: Có chuyện gì với box autolisp này vậy? sao tự nhiên hôm nay mình thấy các topic được dính stick "đáng xem" một cách vô tội vạ thế nhỉ? mất nguyên cả trang đầu và 1/2 trang thứ 2 gồm toàn các topic kiểu "đáng xem" mà nói thực là nhiều trong số đó chẳng đáng xem chút nào.

    • Vote tăng 1

  8. Đã đăng · Trả lời báo cáo

    Mọi người ơi cho em hỏi: em có một thư viện có rất nhiều Lisp, tất cả đang nằm trong cùng một thư mục có tên LISP ở ổ C....em mở autocad và load tất cả lên..các Lisp dùng bình thường.Bây giờ em muốn hỏi: làm sao mình biết được một tên lệnh bất kỳ vừa thực hiện xong đang ở trong file nào của bộ lisp?.Nếu mở từng file lên và search "defun c:tenlenh" mà tìm thì không biết bao giờ mới xong....

    Dùng Google desktop search với từ khóa như trên. nó tìm kiếm nội dung của tất cả các file dữ liệu dạng văn bản: txt, doc, xls, pdf.... chứa trong thư mục chỉ định tìm kiếm

  9. Đã đăng · Trả lời báo cáo

    Chào các bạn. Mình có một câu hỏi muốn nhờ các bạn. Mình muốn dùng hàm ssget để chọn các đối tượng có đặc tính như sau: đối tượng là LWPOLYLINE hoặc đối tượng LINE(có kiểu Linetype là center hoặc center2 không phải HIDDEN hoặc HIDDEN2) hoặc đối tượng là các DIMENSION. Rất mong sự giúp đỡ của các bạn. Thanks.

    (ssget(list '(-4 . "<OR")'(-4 . "<AND")(cons 0 "LINE,LWPOLYLINE")(cons 6 "CENTER,CENTER2")'(-4 . "AND>")'(0 . "DIMENSION")'(-4 . "OR>")))

  10. Đã đăng · Trả lời báo cáo

    - Có vẻ rất trùng với các yêu cầu trước đây của mình. Mình làm thử cho bạn 01 trắc ngang nhé. Xin xem Clip thứ 2 của trang sau

    http://duylisp.page4.me/46.html

    Làm như bác thì chắc fải mất cả ngày cho 1km đường nhỉ. cả cái xuất số liệu sang Tedi trong clip1 của bác nữa. Cứ ngồi mà pick thế thì cũng coi như đi tong 1 ngày chỉ để chuyển đổi số liệu cho 1 công trình vài Km. Công việc í mình nghĩ chỉ cần quệt 2 nhát chuột cho tất cả trắc ngang là xong thôi, chả fải hộp thoại, chả fải pick pick pick làm gì cho nó lằng nhằng vất vả

    @Ketxu: hoặc là bác ấy gợi ý hướng làm cho ai đó có thể viết. hoặc là bác ý đang muốn khoe, hoặc là để câu view cho site của bác ý ^_^

  11. Đã đăng · Trả lời báo cáo

    hề hề, mọi nguời không ném kệ mọi nguời. Em là em fải ném. Đá to cho Bác Duy đây:

    Bác đặt tên biến rất ngắn, mà rất nhiều biến của bác chưa định nghĩa là biến cục bộ. điều này dễ gây xung đột với các lisp khác của người dùng bác ah. Em test fát là có lệnh của em bị dính lun :rolleyes:

    • Vote tăng 1

  12. Đã đăng · Trả lời báo cáo

    cái đó mình nghĩ là không khó lắm, nếu bạn đã từng sử dụng Photoshop thì sẽ thấy rằng xử lý các hiệu ứng đó rất đơn giản theo layer. điều quan trọng ở đây là có thể phần mềm này xử lý trực tiếp từ 1 file nguồn định dạng DWG để cho ra đuợc kết quả như trên.

    • Vote tăng 1

  23. Đã đăng · Trả lời báo cáo

    Hình như bác DVH chưa bao giờ sử dụng file acad.pgp để đổi tên 1 lệnh thì fải.

    - Số 1 của bác: Vì bác chưa cập nhật lại file acad.pgp cho cad, có 3 cách: khởi động lại cad; dùng lệnh reinit; đơn giản hơn nữa là sửa nội dung acad.pgp bằng express > tool > command alias editor nó sẽ tự cập nhật lại acad.pgp luôn

    - Số 2 của bác: chỗ này thì bác ngộ nhận thật. ObjectScale là lệnh của cad, không fải của Express. thêm nữa là dù cho nó có là lệnh của cad đi nữa thì không fải lệnh nào của cad cũng có thể viết duới dạng 1 hàm lisp kiểu (C:tenlenh... lệnh này cũng vậy.

    PS: có thể bác cho là tôi hơi nhiều chuyện, nhưng giờ này mà bác còn lạch cạch với cad2007 thì tự bác đã tạo ra những thiệt thòi lớn cho mình trong nghề rồi đấy. đừng quá đề cao Lisp, Các bản cad đời cao hơn cung cấp rất nhiều công cụ tốt để giảm gánh nặng công việc mà bác cứ ngồi đó, mòn đít viết lisp cũng không bằng đâu.

  25. Đã đăng · Trả lời báo cáo

    ah, nếu bạn sử dụng cad 2008 trở lên và dùng các đối tuợng có thuộc tính annotative để dễ dàng trong quản lý tỷ lệ vẽ và tỷ lệ in ấn thì bạn mới sử dụng lệnh này.

    đối tượng điều chỉnh của lệnh objectscale là các annotative object. bạn tham khảo bản vẽ mình post trong topic này

    Vì lệnh này tên quá dài nên mình muốn thu ngắn lại bằng 1 lệnh tắt nào đó, AD chẳng hạn. cách đơn giản nhất là sửa file acad.pgp như mọi nguời thuờng dùng bằng cách thêm vào đó dòng AD, *Objectscale. nhưng mình không muốn dùng cách này bởi bởi mỗi lần cài lại cad là lại phải sửa lại nó, mặt khác nó cũng không tiện khi mình làm việc trên máy nguời khác. làm như vậy sẽ gây ra thay đổi cấu trúc lệnh cad của họ.

    thay vì thế thì mình muốn đưa lệnh này vào bộ lisp của mình luôn để tiện sử dụng di động ý mà.

×