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

nhờ kết hợp 2 lisp

Bởi buithengan1 , trong AutoLisp

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

buithengan1    1

buithengan1
Đã đăng

http://www.cadviet.com/upfiles/3/52064_lisp.rar

mình có 2 lisp 1 lisp do độ dài đoạn thẳng và cập nhật vào 1 text và tự động thay đổi khi kích thước đường thẳng thay đổi (lisp tính lệnh là LL) nhưng hạn chế của nó là chỉ đo được 1 đường thẳng.

 

1lisp đo được nhiều đoạn thẳng (lisp tg lệnh là tg) nhưng không tự động cập nhật vào text được.

 

 

Mấy bạn giúp mình làm 1 lisp đo độ dài của nhiều đoạn thẳng và tự động cập nhật vào text hộ mình với cảm ơn các bạn nhiều

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

Tot77    508

Tot77
Đã đăng

Cái này trước đây cũng có người hỏi rồi.

Tôi có 1 cái lsp có thể tự động cập nhật chiều dài, nhưng chỉ dùng với pline thôi, ko dùng cho line.

  • 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

buithengan1    1

buithengan1
Đã đăng

Cái này trước đây cũng có người hỏi rồi.

Tôi có 1 cái lsp có thể tự động cập nhật chiều dài, nhưng chỉ dùng với pline thôi, ko dùng cho line.

bạn có thể cho mình xin lisp đó được ko?

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

Tot77    508

Tot77
Đã đăng

Thật ra cái này tuy tôi viết cũng lâu rồi nhưng chỉ mang tính thử nghiệm (làm cho biết), chưa có ứng dụng thực tế.

Bạn muốn dùng thì down cái lsp này về.

Trong file bạn phải có sẵn pline và text cho từng đoạn của pline (đặt text gần cái đoạn của nó).

Đánh lệnh "tao", chọn pline, quét các text của pline. XOng vẫn chưa thấy có gì khác, tuy nhiên nếu bạn thay đổi chiều dài đoạn thì text sẽ đổi.

Làm xong nhớ save file. 

Lần sau mở file lại load cái lsp này vào để cad hiểu các hàm của nó, nhưng không cần đánh lệnh "tao" lại (lệnh này chỉ làm 1 lần cho 1 pline thôi).

 

(defun print-length (notifier-object reactor-object parameter-list / lvt pl n tm)
    (setq lvt (getLength (setq pl (vlax-vla-object->ename notifier-object))))
    (mapcar '(lambda(x)
(setq obj (vla-HandleToObject adoc (last x)))
(vla-put-textstring obj (nth (car x) lvt))
(setq tm (laydinhdoan pl (car x)))
(vla-put-rotation obj (if (< (caar tm) (caadr tm)) (angle (car tm) (last tm))
     (angle (last tm) (car tm) )))       
(vla-put-TextAlignmentPoint obj (vlax-3d-point (midp (car tm) (last tm)))))
   
  (vlax-ldata-get "Rdict" (dxf 5 pl)))
    (princ) 
  )
  
  (defun laydoan(pl pt / obj) 
    (fix (vlax-curve-getParamAtPoint pl (vlax-curve-getClosestPointTo pl pt))))
  
  (defun laydinhdoan(pl n / obj) 
    (list (vlax-curve-getPointAtParam pl n) (vlax-curve-getPointAtParam pl (1+ n))))
  
  (defun getLength(pl / vt l obj)
    (setq vt 0 l nil)
    (repeat (fix (vlax-curve-getEndParam pl))
      (setq l (append l (list (rtos (- (vlax-curve-getDistAtParam pl (setq vt (1+ vt)))
              (vlax-curve-getDistAtParam pl (1- vt))) 2 0)))))
    l
  )
 
(defun C:tao (/ mypLine tt5 pl)
  (setq mypLine  (vlax-ename->vla-object (setq pl (car (entsel "\nChon Polyline:"))))
tt5 (dxf 5 pl))
  (prompt "\nChon text ghi chieu dai:")  
  
  (if (vlax-ldata-get "Rdict" tt5) (vlax-ldata-delete "Rdict" tt5))
  
  (vlax-ldata-put "Rdict" tt5
    (mapcar '(lambda(x)  (list (laydoan pl (vlax-curve-getClosestPointTo mypLine (dxf 10 x)))
(vla-get-Handle (vlax-ename->vla-object x)))) (ssto (ssget '((0 . "TEXT"))))))
  
  (setq plineReactor (vlr-object-reactor (list mypLine) "PLine Reactor" '((:vlr-modified . print-length))))
  (vlr-pers plineReactor)
  (princ)
)
  • Vote tăng 2

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

Tot77    508

Tot77
Đã đăng

Sorry, bạn chép thêm mấy cái hàm này đặt trong file lsp trên , nếu không sẽ báo lỗi (các hàm này vì tôi hay dùng nên tôi để chỗ khác)

 

(vl-load-com)
(defun dxf(id v) (cdr (assoc id (entget v))))
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(defun midp(d1 d2) (polar d1 (angle d1 d2) (* 0.5 (distance d1 d2))))
(defun ssto (ss) (if ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) nil))
  • Vote tăng 3

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

Tot77    508

Tot77
Đã đăng

Tôi không thích dùng field vì những lý do sau:

1. Nó tạo 1 cái background quanh text, không đẹp.  :(

2. Phải regen mới cập nhật.

3. Công thức rắc rối và không linh động, khó nhét lisp vào công thức.

  • Vote tăng 2

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

Tot77    508

Tot77
Đã đăng

Thanks hanhphuc đã giới thiệu thêm 1 cái biến của cad, nhưng đó chỉ là lý do phụ thôi khiến tôi không thích dùng field.

Khi lần đầu thấy có người đề nghị sửa cái lisp ban đầu để dùng cho pline, thì tôi cũng làm thử với field, nhưng thấy khó nuốt quá (do cái lý do thứ 3 kể trên) nên tôi mới thử chuyển qua dùng reactor. Thấy reactor hay hơn nên xài luôn.

Bên trên tôi quên không nói tới việc text khi dủng với field nó không "thèm"di chuyển khi  chiều dài pline,thay đổi, còn dùng reactor thì nó di chuyển ngon là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

hung_xu20032000    2

hung_xu20032000
Đã đăng

Mình cũng muốn kết hợp 2 lisp. Các bác hộ e với.http://www.cadviet.com/upfiles/3/8800_dtich_v_1.lsp và http://www.cadviet.com/upfiles/3/8800_tkh_1.lsp

khi đánh "v" sẽ ra được diện tích vùng được giới hạn và diện tích của layer được chọn. Cảm ơn các bác. 

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

ketxu    2.984

ketxu
Đã đăng

Hôm trước hỏi bạn n k thấy đồng ý, hôm nay lại thấy 2pic được khơi lại, ket lại vô chém bừa.

1. Có background mới là cái người dùng cần. Thứ nhất là nó không ảnh hưởng đến việc in ấn. Thứ 2 là có nó người dùng mới biết đâu là 1 text có liên kết mà không vô tình Edit nó. Biến điều khiển thì đã có post ở trên rồi.

 

2. Regen chỉ là để hiển thị cho mắt người đọc thôi. Nếu thấy lệnh này làm chậm tốc độ, bạn có thể nghĩ đến sử dụng lệnh Update Field, tự người dùng đánh hoặc reactor tự động sau 1 khoảng thời gian nào đó nếu trên khung nhìn hiện tại có chứa Field. Ý tưởng này hình như có bác đề xuất lâu lâu rồi, làm cũng không khó, nhất là khi kết hợp với DBMod

 

- Ngoài ra bạn cũng có thể sẽ ngạc nhiên với biến FieldEval. Biến này sẽ giúp chúng ta chẳng cần phải quan tâm đến việc nó hiển thị lúc này ra sao, kết quả nhận được khi ở trên tờ giấy luôn ngon lành

 

3. Công thức Field không phức tạp lắm đâu, có quy luật hết rồi mà.

 

4. Không bị phụ thuộc.

- Field còn cho phép mở rộng ra nhiều Properties, Biến, Công thức, Diesel ... Cái này chắc bạn thấy trong bảng lệnh Field rồi hén. Code của bạn viết cho Length dài vậy rồi, đến lúc viết cho các thứ khác thì chắc mệt lắm..

- Không cần phải load code của bạn để sử dụng hiệu ứng. Chỉ cần dùng bản CAD hỗ trợ Field là đủ.

- Có thể tự sửa công thức nếu thích. Mà Format của kết quả cũng được linh động

...

 

5. Với lại hình như cái code có vấn đề hay sao đó, hồi lâu lâu ket test thử thấy nó không cập nhật ngay, phải chờ mình thay đổi đối tượng. Không tính toàn bộ Pline (hình như tính có 1 segment thôi). Và nếu muốn sửa thì mình chịu chết ^^

 

6. Cám ơn bạn vì sự sáng tạo. Mình học được nhiều trong code này, nhưng cũng chưa viết được cái j mới cả ^^ Tạm để đó đã ^^

  • 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

Tot77    508

Tot77
Đã đăng

Nói chung không có ý tranh luận làm gì, đơn giản là thấy field khó xài hơn reactor nên dùng reactor.

Nếu có ai rành về field và lisp thì làm thử bài toán trên để tôi được mở rộng tầm mắt.

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    3.201

Doan Van Ha
Đã đăng

Hôm trước hỏi bạn n k thấy đồng ý, hôm nay lại thấy 2pic được khơi lại, ket lại vô chém bừa.

1. Có background mới là cái người dùng cần. Thứ nhất là nó không ảnh hưởng đến việc in ấn. Thứ 2 là có nó người dùng mới biết đâu là 1 text có liên kết mà không vô tình Edit nó. Biến điều khiển thì đã có post ở trên rồi.

 

2. Regen chỉ là để hiển thị cho mắt người đọc thôi. Nếu thấy lệnh này làm chậm tốc độ, bạn có thể nghĩ đến sử dụng lệnh Update Field, tự người dùng đánh hoặc reactor tự động sau 1 khoảng thời gian nào đó nếu trên khung nhìn hiện tại có chứa Field. Ý tưởng này hình như có bác đề xuất lâu lâu rồi, làm cũng không khó, nhất là khi kết hợp với DBMod

 

- Ngoài ra bạn cũng có thể sẽ ngạc nhiên với biến FieldEval. Biến này sẽ giúp chúng ta chẳng cần phải quan tâm đến việc nó hiển thị lúc này ra sao, kết quả nhận được khi ở trên tờ giấy luôn ngon lành

 

3. Công thức Field không phức tạp lắm đâu, có quy luật hết rồi mà.

 

4. Không bị phụ thuộc.

- Field còn cho phép mở rộng ra nhiều Properties, Biến, Công thức, Diesel ... Cái này chắc bạn thấy trong bảng lệnh Field rồi hén. Code của bạn viết cho Length dài vậy rồi, đến lúc viết cho các thứ khác thì chắc mệt lắm..

- Không cần phải load code của bạn để sử dụng hiệu ứng. Chỉ cần dùng bản CAD hỗ trợ Field là đủ.

- Có thể tự sửa công thức nếu thích. Mà Format của kết quả cũng được linh động

...

 

5. Với lại hình như cái code có vấn đề hay sao đó, hồi lâu lâu ket test thử thấy nó không cập nhật ngay, phải chờ mình thay đổi đối tượng. Không tính toàn bộ Pline (hình như tính có 1 segment thôi). Và nếu muốn sửa thì mình chịu chết ^^

 

6. Cám ơn bạn vì sự sáng tạo. Mình học được nhiều trong code này, nhưng cũng chưa viết được cái j mới cả ^^ Tạm để đó đã ^^

Có vài thông tin hay.

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

ketxu    2.984

ketxu
Đã đăng

Nói chung không có ý tranh luận làm gì, đơn giản là thấy field khó xài hơn reactor nên dùng reactor.

Nếu có ai rành về field và lisp thì làm thử bài toán trên để tôi được mở rộng tầm mắt.

 

Search nhẹ cái ra ngay này Tot77, ket post luôn code nhé ^^

 

;;--------------------=={ Length Field }==--------------------;;
;;                                                            ;;
;;  Creates an MText Field referencing the sum of the lengths ;;
;;  of selected objects.                                      ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:LenField ( / acdoc acspc format pt ss )

  (setq format "%lu6%qf1") ;; Field Formatting

  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
        acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
  )  
  (if
    (and
      (ssget '((0 . "LINE,*POLYLINE")))
      (setq pt (getpoint "\nPick Point for Field: "))
    )
    (
      (lambda ( ss fld )
        (vlax-for obj ss
          (setq fld
            (strcat fld "%<\\AcObjProp Object(%<\\_ObjId "
              (LM:GetObjectID acdoc obj) ">%).Length>% + "
            )
          )
        )
        (vla-addMText acspc (vlax-3D-point (trans pt 1 0)) 0.
          (setq fld
            (strcat
              (substr fld 1
                (- (strlen fld) (if (< 1 (vla-get-Count ss)) 3 5))
              )
              " \\f \"" format "\">%"
            )
          )
        )
        (vla-delete ss)
      )
      (setq ss (vla-get-ActiveSelectionSet acdoc))
      (if (< 1 (vla-get-Count ss)) "%<\\AcExpr " "")
    )
  )
  (princ)
)

;;-------------------=={ Get ObjectID }==---------------------;;
;;                                                            ;;
;;  Returns the ObjectID string for the supplied VLA-Object   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  doc - VLA Document Object (req'd for 64-bit systems)      ;;
;;  obj - VLA Object to query                                 ;;
;;------------------------------------------------------------;;
;;  Returns:  ObjectID string for VLA-Object                  ;;
;;------------------------------------------------------------;;

(defun LM:GetObjectID ( doc obj )
  (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
    (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
    (itoa (vla-get-Objectid obj))
  )
)

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

Tot77    508

Tot77
Đã đăng

 Cái này của Lee  Mac cũng chỉ là quan hệ dạng 1 <-> 1 như cái list c:LL ở #1 thôi, chứ không phải dạng n <-> n, chỉ tính tổng chiều dài pline chứ không tính từng segment, vả lại cũng không  thấy LM nhét biểu thức lisp và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

ketxu    2.984

ketxu
Đã đăng

Gần như không hiểu ý Tot77 luôn. Ket dừng ý kiến tại đây ^_^

 

Mấy bạn giúp mình làm 1 lisp đo độ dài của nhiều đoạn thẳng và tự động cập nhật vào text hộ mình với cảm ơn các bạn nhiều

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

hung_xu20032000    2

hung_xu20032000
Đã đăng

http://www.cadviet.com/upfiles/3/8800_dtich_v_1.rar và http://www.cadviet.com/upfiles/3/8800_tkh_1.rar các bác hộ e với. E xin cảm ơn. Lisp của e như sau. Đánh "V" sẽ ra diện tích vùng bao và diện tích hatch theo vùng bao tự điền diện tích vào text đã có. 

  • Vote giảm 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

Tot77    508

Tot77
Đã đăng

ôi thấy cái lệnh V sẽ cho ra tổng diện tích của vùng mình pick, còn cái lệnh tkh thì chọn hatch có sẵn rồi tính diện tích theo layer.

Vậy có phải mục đích cuối cùng của bạn là sau khi bạn pick vào các vùng chọn, nó sẽ tạo ra hatch , rồi tính  tổng dịện tích và đưa racủa những vùng đó ra text và diện tích đó là của layer hiện hà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

hung_xu20032000    2

hung_xu20032000
Đã đăng

Ý của e là chỉ dùng 1 lệnh sẽ tính ra được diện tích vùng pick và diện tích hatch có trong vùng pick day thoi. (lệnh tkh tính diện tích toàn bộ vùng hatch). e làm bên địa chất. Toàn bộ vùng hatch e không lấy hết, chỉ lấy diện tích vùng pick thôi (diện tích vùng pick có thể bên trái hoặc bên phải đường giới hạn).

http://www.cadviet.com/upfiles/3/8800_gui_cadviet_1.dwg

 

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

Tot77    508

Tot77
Đã đăng

Vậy bạn thử cái này, lệnh V, chọn tỷ lệ, chọn vị trí đặt text kết quả, nhấp vùng cần chọn, xong enter.

Trước khi vào lệnh thì cho biến textsize to nhỏ tùy ý (trong bản vẽ bạn đưa thấy biến này hơi nhỏ).

Nếu nó không bắt được cái hatch naò trong vùng pick thì nó sẽ hỏi chọn đối tượng để lấy layer.

 

 

(defun c:v(/ tl1 ntl tl2 dtl ss hat hatlay oslast txtsiz pt1 et vsize dtcon elst)
  (if (= tl nil) 
    (setq tl (getreal "\nDrawing scale : "))    
  )
  (setq ntl (/ 1000 tl))
  (setq tl2 (* ntl ntl))
  (setq dtl 0)
  (setq ss (ssadd) hat nil)
  (setq oslast (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (print)
  (if (not pt0) (setq pt0 (getpoint "\nChon diem dat text:")))
  (setq txtsiz (getvar "textsize"))
 
  (setq pt1 (getpoint "\nPick internal point : "))
  (while (/= pt1 nil)
    (if (not hat)
      (progn
        (setq hat (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget pt1 '((0 . "HATCH")))))))
        (if hat (setq hatlay (cdr (assoc 8 (entget (car hat)))))))
    )    
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( / (getvar "VIEWSIZE") 3 ))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (getvar "AREA"))
    (setq dtl (+ dtcon dtl))
    (print)
    (setq pt1 (getpoint "\nPick internal point : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw")
  (setq dtl (/ dtl tl2))
  (print dtl)
  (if (not hatlay) (setq hatlay (cdr (assoc 8 (entget (car (entsel "\Chon layer theo:")))))))
  (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
    (strcat hatlay " : " (rtos dtl 2 2)) (vlax-3d-point pt0) txtsiz)
  (setq pt0 (polar pt0 -1.5708 (* 2 txtsiz)))
  (print)
)
  • 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
Về Đầu Trang AutoLisp
×