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

huunhantvxdts

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    857

  • Đã tham gia

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

  • Ngày trúng

    40

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

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

    2 phút trước, vuhoach đã nói:

    Đúng rồi bác, nhưng lisp xuất tọa độ thông thường phải ghi tên điểm thủ công, hoặc đánh stt tự động nhưng stt này không khớp với tên điểm đã có. Vì vậy mà em muốn trên để công việc tự động cao hơn 

    Bạn phải gửi file cad của bạn lên để có cơ sở mới làm được:

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

    9 giờ trước, vuhoach đã nói:

    Chào các bác, bài toán của mình như này: Mình cần xuất tọa độ của các block đèn kèm tên của nó. Như hình bên dưới là các cột đèn kèm tên của nó (tên đèn là block attribute), mình đã có lisp chuyển các đèn kia thành point, và lisp move text tới point (đính kèm bên dưới cho anh em nào cần). Nhưng do block tên đèn của mình bên trong gồm cả text lẫn attribute, dùng lệnh burst của cad có thể chuyển các attribute trong block thành text nhưng sau khi thực hiện lệnh này thì bị lẫn cả text cần lấy tọa độ lẫn text rác. Mình có thể xử lý, lọc được để lấy tọa độ text mong muốn nhưng rất mất công. Vì vậy mình muốn có một lisp có thể move thẳng block tới point để thao tác nhanh gọn hơn. Khi đó bài toàn xuất tọa độ đối tượng kèm tên sẽ đơn giản hơn rất nhiều: dùng 1 lisp chuyển block đèn kia thành point (mình đã có) -> dùng lisp đang nhờ các bạn viết move block tên đèn vào các point vừa tạo(hoặc chỉnh sửa lisp mình đính kèm) -> xuất tọa độ các block atrribute tên đèn (lisp này cũng đã có).

     

    PS: lisp move text to point đính kèm là của Lee-Mac

    image.png.d4e36775500bc9cd82c7447c15b3346e.png

    txt2pt MOVE TEXT TO POINT.LSP

    Mình nghĩ bài toán này không khó với mẫu file như hình

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

    18 giờ trước, traichoi85 đã nói:

    Chào các bạn.

    Hiện nay mình có 1 dự án khoảng 500 lô nhà. file đã có số lô. mà mình muốn thêm trong mỗi lô là 1 block ( để mình làm block thuộc tính). nếu làm thủ công thì rất lâu, và phương án của mình thì sửa liên tục. Nên nhờ các bạn giúp dùm, nếu được các bạn có thể giúp thêm là xoay block theo hướng lô đất luôn.  (có file đính kèm và video hỏi đính kèm)

    file youtube: https://youtu.be/xZdQ5gw2coA

    file 

    chuyen dt Thanh block.dwg

    Bộ lisp mình đã có sẳn lệnh như này bạn nhé

    đây bạn nhé: Cập nhật lisp Phân Lô - YouTube 

    https://www.youtube.com/watch?v=mwqQTzMN9bI

    Liên hệ zalo: 0848.998.045

     

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

    5 giờ trước, Lâm Vũ đã nói:

    Em chào các bác ạ. Chả là em có Down được 1 lisp nối các line, poline với nhau. Nhưng em đang gặp vấn đề là có 3 đường thằng khác nhau nhưng em chỉ muốn nối 2 thằng đầu với nhau thôi nhưng khi dùng lisp thì quét chọn 2 cái đầu thì nó lại nối cả 3 đường đấy với nhau. Hoặc chỉ cần chọn vào 1 đường thẳng bất kỳ thì cũng nó cũng nối cả 3 ạ. Giờ em muốn chọn vào thằng nào thì thằng đấy nối lại thôi ạ, bằng 2 hình thức quét hoặc chọn từng đối tượng. Em xin cám ơn ạ. Chúc các bác thật nhiều sức khỏe.

    11. Noi Line thanh Pline - NN.LSP

    Sua Lisp NN.dwg

    Đây bạn nhé, cái này lấy của bạn ketxu sửa lại tí cho nó nhận 2d polyline 

    (defun C:noi ( / c l o )
;Ketxu 9-2012
;Join objects
    (if (setq s (ssget "_:L" '((0 . "LINE,ARC,LWPOLYLINE,POLYLINE"))))
        (progn
            (setq o (mapcar 'getvar (setq l '("peditaccept" "cmdecho"))))
            (mapcar 'setvar l '(1 0))            
            (command "_.pedit" "_M" s "" "_J" "" "")
            (mapcar 'setvar l o)
        )
    )
    (princ)
)

     

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

    Gửi tặng bạn điều kiện đường bao bên ngoài phải là đường polyline (nếu bên trong có đường Polyline nữa thì phải xét đến layer nhé) 

    (defun c:TNBL (/ cur_lay oldos lstpl stt o p3 p4 ss ten)
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(command "UNDO" "Be")
(vl-load-com)
(prompt "\nChon duong bao Polyline")
(setq lstpl (CV:ss-to-list (ssget '((0 . "LWPOLYLINE"))) T))
(setq stt 1)
(foreach ent lstpl
(setq o ent)
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
(setq p3 (vlax-safearray->list a))
(setq p4 (vlax-safearray->list b))
(setq ss (ssget "C" p3 p4))
(setq ten (menucmd "M=$(edtime, $(getvar, date),MODDYYHHMMSS)"))
(setq ten (strcat ten (rtos stt 2 0)))
(command "_.-block" ten  p3 ss "")
(command "_.insert" ten "_S" 1 p3 "")
(setq stt (+ stt 1))
)
(command "UNDO" "End")
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
(princ)
)
(defun CV:ss-to-list (ss vla / n e l)
(if ss
(progn
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (if vla (vlax-ename->vla-object e) e) l))
)
)
)
)

     

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

    55 phút trước, sam8xd đã nói:

    Hầu hết lisp hay của cadviet đều có trong bộ lisp bro. Với ace làm đường, hầm thủy điện, cầu, thủy lợi, ... thì best choice đấy ạ

    Ý là các bạn phản ánh đã số lisp lấy từ diễn đàn về sao lại tính phí!!!!!

    • Like 1

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

    17 giờ trước, nguyenvinh5779 đã nói:

    chào các bạn ! mình có tìm duoc lisp đo diện tích nhưng hơi bất  tiện,

    Nhờ các bạn biết về lisp chỉnh giúp ghi ra m2 ( chứ khong ghi ra mm)

    Xin cám ơn các bạn đ ạ giúp !

    area.LSP

    Gửi bạn nhé  

    (defun c:SubArea ( / txtht ar e pl pls i str)
(vl-load-com)      
(setq txtht (cond ((getdist (strcat
               "\nEnter Text Height [Enter to accept: <"
               (rtos (setq txtht (getvar 'textsize)) 2 2)
               ">: ")))(txtht)
         ))
(setvar 'textsize txtht )
(princ "\nSelect Polyline for Area:")
(cond ((and (setq ar 0
                 pl (ssget "_:S:E" '((0 . "*POLYLINE"))))
           (progn (redraw (ssname pl 0) 3)
                  (princ "\t<<<< Select Objects to Subtract >>>>")
                  (setq plS (ssget)))
           (repeat (setq i (sslength pls))
                 (if (vlax-property-available-p
                           (setq e    (vlax-ename->vla-object
                                            (ssname
                                                  pls
                                                  (setq i    (1- i)))))
                           'Area)
                       (setq ar (+ (vla-get-area e) ar))
                       T
                       )
                 )
           (setq pt (getpoint "\nPick point for Text:"))
           (entmakex
                 (list (cons 0 "MTEXT")
                       (cons 100 "AcDbEntity")
                       (cons 100 "AcDbMText")
                       (cons 10 pt)
                       (cons 1
  (setq str  (rtos (/ (- (vla-get-area
   (vlax-ename->vla-object (ssname pl 0))) ar) 1000000)
                                              2 2)
                                   )))
                 )
           (princ (strcat "\nTotal Area " str))
           (redraw (ssname pl 0) 4)
           )
      )
     )
     (princ)
     )

     

    • Like 1

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

    4 giờ trước, pdhuyxn2 đã nói:

     Nhờ Các Bác sửa giúp em code trên move hàng loạt đối tượng lên trên đường polyline .

    Move.dwg

    Gửi bạn nhé

    lệnh MDT 

    (defun CV:ss-to-list (ss vla / n e l)
(if ss
(progn
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (if vla (vlax-ename->vla-object e) e) l))
)
)
)
) 
(defun LM:SelectIf ( msg pred func keyw / sel )
(setq pred (eval pred))
(while
(progn
(setvar 'ERRNO 0)
(if keyw (apply 'initget keyw))
(setq sel (func msg))
(cond
((= 7 (getvar 'ERRNO)) (princ "\nMissed, Try again."))
((eq 'STR (type sel)) nil)
((vl-consp sel) (if (and pred (not (pred sel))) (princ "\nInvalid Object Selected."))))))
sel)
(defun c:MDT (/ lstdt pl lstline lsttextvitri lsttextcoc point pointpl gocvuong pointden)
(setq lstdt (CV:ss-to-list (ssget '((0 . "TEXT,LINE"))) nil))
(setq pl (car (LM:SelectIf "\nChon duong Polyline:" (lambda (x) (eq "LWPOLYLINE" (cdr (assoc 0 (entget (car x)))))) 
															entsel nil)))
(setq lstline (vl-remove-if-not '(lambda (x) (= (cdr (assoc 0 (entget x))) "LINE")) lstdt))
(setq lsttextvitri (vl-remove-if-not '(lambda (x) (= (cdr (assoc 8 (entget x))) "_VITRI_")) lstdt))
(setq lsttextcoc (vl-remove-if-not '(lambda (x) (= (cdr (assoc 8 (entget x))) "_TENCOT_")) lstdt))
(foreach line lstline
(setq point (cdr (assoc 10 (entget line))))
(setq pointpl (vlax-curve-getClosestPointTo pl point))
(setq gocvuong (GetAngleVuong pl pointpl))
(setq pointden (polar pointpl gocvuong 27.24))
;(setq newobj (vla-copy (vlax-ename->vla-object dtcp)))
(vla-move (vlax-ename->vla-object line) (vlax-3D-point point) (vlax-3D-point pointden))
)
(foreach textvt lsttextvitri
(setq point (cdr (assoc 10 (entget textvt))))
(setq pointpl (vlax-curve-getClosestPointTo pl point))
(setq gocvuong (GetAngleVuong pl pointpl))
(setq pointden (polar pointpl gocvuong 36))
;(setq newobj (vla-copy (vlax-ename->vla-object dtcp)))
(vla-move (vlax-ename->vla-object textvt) (vlax-3D-point point) (vlax-3D-point pointden))
)
(foreach textcoc lsttextcoc
(setq point (cdr (assoc 10 (entget textcoc))))
(setq pointpl (vlax-curve-getClosestPointTo pl point))
(setq gocvuong (GetAngleVuong pl pointpl))
(setq pointden (polar pointpl gocvuong 6))
;(setq newobj (vla-copy (vlax-ename->vla-object dtcp)))
(vla-move (vlax-ename->vla-object textcoc) (vlax-3D-point point) (vlax-3D-point pointden))
)
(princ)
)
(defun GetAngleVuong (obj pt)
(+ (angle pt (polar pt (angle '(0 0 0) (vlax-curve-getFirstDeriv obj (vlax-curve-getParamAtPoint obj pt))) 2)) (* pi 0.5))
)

     

    • Like 2

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

    32 phút trước, nguyenvinh5779 đã nói:

    Mình có download lisp trên mạng 

    Lisp chuyenn từ model sang layout , và từ layout này sang layout khác

    Do nhu cau cong việc làm trên layout nhiều 

    Nen mình xin nho các bạn chinh giúp chuyển từ layout nay sang layout khác mà khong chuyen sang model !

    Xin cam on 

    zv.lsp

    Sửa cho bạn nhé:

    lệnh CLa 

    ;; Created by: Lee Ambrosius
;; Date Written: 12/11/03

;; Includes four commands which can be redefined.
;; NextLayout - Navigates to the right and will wrap around
;;              to the left side once the end is reached

;; PreviousLayout - Navigates to the left and will wrap around
;;                  to the right side once the end is reached

;; FirstLayout - Navigates to the left most tab

;; LstLayout - Navigates to the right most tab

;; Gets a listing of all Layouts in the drawing
(defun Get-Layout-List( / acadObj acDoc acDocLayouts layoutCount loopCount
                         layoutListLocal layoutListSorted layoutName layoutPosition
                         loopCountSorted)
 (vl-load-com)
 (setq acadObj (vlax-get-acad-object))
 (setq acDoc (vlax-get-property acadObj 'ActiveDocument))
 (setq acDocLayouts (vlax-get-property acDoc 'Layouts))

 (setq layoutCount (vlax-get-property acDocLayouts 'Count)
       loopCount 0
       layoutListLocal (list)
       layoutListSorted (list)
 )
 
 (while (> layoutCount loopCount)
   (setq layoutName (vlax-get-property (vlax-invoke-method acDocLayouts 'Item loopCount) 'Name))
   (setq layoutPosition (vlax-get-property (vlax-invoke-method acDocLayouts 'Item loopCount) 'TabOrder))

   (setq layoutListLocal (append layoutListLocal (list (list layoutPosition layoutName))))
   (setq loopCount (1+ loopCount))
 )

 ;; Resort listing by TabOrder
 (setq layoutCountSorted 0)
 (while (> (length layoutListLocal) (length layoutListSorted))
   (setq loopCountSorted 0)
   (foreach layoutLocation layoutListLocal
     (progn
       (if (and (= (car layoutLocation) (length layoutListSorted)) (= (car layoutLocation) layoutCountSorted))
         (progn
           (setq layoutListSorted (append layoutListSorted (cdr (nth loopCountSorted layoutListLocal))))
       (setq layoutCountSorted (1+ layoutCountSorted))
         )
       )
       (setq loopCountSorted (1+ loopCountSorted))
     )
   )
 )
 layoutListSorted
)

(defun c:ll ( / layout-mem-list layout-list layoutLocation)
 (setq layoutLocation 0)
 (setq layout-list (get-layout-list))
 (setq layout-mem-list (member (getvar "CTAB") layout-list))
 (if layout-mem-list
   (progn
     (setq layoutLocation (- (length layout-list) (length layout-mem-list)))
   )
   (setq layoutLocation (1+ layoutLocation))
 )
 (if (>= (1+ layoutLocation) (length layout-list))
   (setvar "CTAB" (nth 0 layout-list))
   (setvar "CTAB" (nth (1+ layoutLocation) layout-list))
 )
)

(defun c:lll ( / layout-mem-list layout-list layoutLocation)
 (setq layoutLocation 0)
 (setq layout-list (get-layout-list))
 (setq layout-mem-list (member (getvar "CTAB") layout-list))
 (if layout-mem-list
   (progn
     (setq layoutLocation (- (length layout-list) (length layout-mem-list)))
   )
   (setq layoutLocation (1- layoutLocation))
 )
 (if (= layoutLocation 0)
   (setvar "CTAB" (nth (1- (length layout-list)) layout-list))
   (setvar "CTAB" (nth (1- layoutLocation) layout-list))
 )
)

(defun c:llll ( / layout-list layoutLocation)
 (setvar "CTAB" (nth 0 (get-layout-list)))
)

(defun c:LastLayout ( / layout-list)
 (setq layout-list (get-layout-list))

 (setvar "CTAB" (nth (- (length layout-list) 1) layout-list))
)
(defun c:cla ( / layout-mem-list layout-list layoutLocation)
 (setq layoutLocation 0)
 (setq layout-list (get-layout-list))
 (setq layout-mem-list (member (getvar "CTAB") layout-list))
 (if layout-mem-list
   (progn
     (setq layoutLocation (- (length layout-list) (length layout-mem-list)))
   )
   (setq layoutLocation (1+ layoutLocation))
 )
 (if (>= (1+ layoutLocation) (length layout-list))
   (setvar "CTAB" (nth 1 layout-list))
   (setvar "CTAB" (nth (1+ layoutLocation) layout-list))
 )
)
(princ)

     

    • Like 1

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

    3 giờ trước, trungkien8338 đã nói:

    (defun c:hh()
        (setq obj (vlax-ename->vla-object(car (entsel)))) ; đối tượng được chọn là một block có nhiều attribute
         ;lay attribute
        (setq sal (vlax-safearray->list (vlax-variant-value (vla-getattributes obj))))
        (setq i 0)
        (repeat (length sal)
            (princ (vlax-get-property (nth i sal) 'TextString )) ; chỗ này lấy ra phần tiếng việt bị lỗi font
            (princ "\n")
            (setq i (+ 1 i))
        )
        
    )

    NHỜ CÁC BÁC XEM GIÚP.

    ở trên đã bảo chuyển về ename để lấy nội dung text mà bạn

     

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

    5 giờ trước, tung89gt đã nói:

    Em chào các bác!

    Em có sưu tập được 1 lisp tính khối lượng mline trên diễn đàn. không nhớ là của bác nào.

    hiện tại em đang vướng mắc một chút là khi sử dụng lisp để tính khối lượng ở lệnh scale thì lisp chỉ quyét được các mline (cùng tỉ lệ scale) chưa lấy đối xứng. nhờ các bác sửa lisp quyét được cả các mline đã bị lấy đối xứng rồi giúp em với!

    Em cảm ơn các bác!

    Drawing1.dwg

    LL.lsp

    Chỉnh lại cho bạn nhé: 

    (defun c:LL ( / txt)

 (initget "ST LA SA")
 (setq txt (getkword "\nLoc MLINE theo [STyle/LAyer/SAcle] <LA>: "))
 (cond
   ((not txt)
   (setq kieu " thuoc STYLE: <") (setq mdxf 2))
   ((= "ST" txt)
   (setq kieu " thuoc STYLE: <") (setq mdxf 2))
   ((= "LA" txt)
   (setq kieu " thuoc LAYER: <") (setq mdxf 8))
   ((= "SA" txt)
   (setq kieu " co SCALE: <") (setq mdxf 40))
 )

(setq ketqua (cdr (assoc mdxf (entget (car (chonmotmline))))))
(setq ss (ssget (list (cons 0 "MLINE") (cons -4 "<OR") (cons mdxf ketqua) (cons mdxf (* ketqua -1) ) (cons -4 "OR>"))))
  (setq tot_len 0.0)
  (setq sml (sslength ss))

  (while (> (sslength ss) 0)
    (setq e_name (ssname ss 0))
    (setq e_record (entget e_name))
    (setq e_type (cdr (assoc '0 e_record)))
    (cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
	   (command "lengthen" e_name "")
	   (setq tot_len (+ tot_len (getvar "PERIMETER")))
	   (ssdel e_name ss)
	  )
	  ((wcmatch e_type "MLINE") (add_mline))
	  (e_type (ssdel e_name ss))
    )
  )

  (cond ((= "SA" txt) (setq ketqua (rtos ketqua 2 2)) ))
  (prompt (strcat "\nTim thay: " (itoa sml) " doi tuong MLINE" kieu ketqua "> tong chieu dai=" (rtos tot_len 2 2)))


(princ))
;;;;;;;;;;;;;;
(defun chonmotmline ( / dchon)
(setq dchon (entsel "\nChon Mline chuan:"))
(while
(or
(null (car dchon))
(and (/= "MLINE" (cdr (assoc 0 (entget (car dchon)))))
)
)
(princ "\nDoi tuong khong phai MLINE. Chon lai !")
(setq dchon (entsel))
)
dchon)
;;;;;;;;;;;;;;
(defun add_mline ()
  (foreach e_record_sub	e_record
    (cond ((= 10 (car e_record_sub))
	   (setq pt1	   (cdr e_record_sub)
		 mline_len 0.0
	   )
	  )
	  ((= 11 (car e_record_sub))
	   (setq pt2	   (cdr e_record_sub)
		 mline_len (+ mline_len (distance pt2 pt1))
		 pt1	   pt2
	   )
	  )
    )
  )
  (setq tot_len (+ tot_len mline_len))
  (ssdel e_name ss)
)

     

    • Like 3

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

    5 giờ trước, 843824 đã nói:

    Xin chào các ACE diễn đàn... đã lâu rồi không dùng lại CAD cần thao tác một số công việc. Do nay mình chỉ xem Bve là chủ yếu. Nên nó lục nghề hẳn... hì hì. 

    Mong mọi người giúp cái Lisp như sau: (có đính kèm bản vẽ - đã làm tay nhưng lâu quá).

    1. Mình cần tạo 1 hệ tọa độ người dùng, vị trí Điểm O của hệ OXY do mình pick.

    - Khoảng cách (bước chia) trên hệ X,Y do mình nhập: trong file đang làm là 10.000 đơn vị CAD = 10.

    1.1. Như vậy khi mình muốn thay đổi gốc tọa độ (O) pick chổ khác, hoặc thay đổi bước chia: các điểm cao độ vẫn giữ thì lisp sẽ tính lại cho mình theo Hệ tọa độ mới.

    2. Mình có các điểm Block ATT là các vị trí đo cao độ mà mình muốn xuất tọa độ (như bảng xuất kế bên). 

    - Base Point của Block ATT là vị trí mình đo.

    - Chỉ có nhu cầu: Xuất các thông tin đã có trong Block ATT và thêm 2 cột tọa độ X, Y (theo trục giả định đã tạo ở 1.) ra file *.TXT là mình xử lý tiếp được rồi.

    3. Nếu thêm được: 

    - Mình xin thêm 1 lệnh là với hệ tọa độ giả định này, người dùng muốn vẽ thêm các điểm Cao độ mới nữa với (X,Y) đã có. Thì nhập (X,Y) cái là sẽ vẽ được đúng vị trí trên hệ tọa độ luôn.

    - Chứ mình làm tay lâu quá.

    ============== Xin cảm ơn mọi người đã đọc tin/ giúp đỡ/ hướng dẫn/ trao đổi ================

    7.2022 Hoi lisp tao he toa do. xuat toa do.dwg

    Nếu chưa ai hỗ trợ liên hệ mình để trao đổi thêm nhé. zalo:0848.998.045

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

    6 giờ trước, ducanh99ht đã nói:

    Em có lips đánh cao độ, nhưng cao độ pick từ lisp sẽ có dạng +123 và e muốn thêm đơn vị m phía sau cao độ. Anh chị nào giúp em với ạ

    DCD-Danh cot cao do.lsp

    gửi bạn nhé 

    (defun c:dcd (/ lstSS txtstr p1 p2 listname txt txt1 ss)
(vl-load-com)

(defun acet-ss-to-list (ss / n e l)
  (setq n (sslength ss))
  (while (setq e (ssname ss (setq n (1- n))))
	(setq l (cons e l))
  )
)



;Gan gia tri goc
(if (not k0) (setq k0 1));;gan gia tri goc
(setq k (getreal (strcat "\n Nhap ty le cua ban ve:1/" (rtos k0 2 0) "")));Nhap ty le ban ve
(if (not k) (setq k k0) (setq k0 k))  
(defun dowith(lstSS / lstSS en str)
(cond  ((setq en  (car (vl-remove-if-not '(lambda(x)(wcmatch (cdadr (entget x))"*TEXT")) lstSS)))(setq str (acet-dxf 1 (entget en)) en (vlax-ename->vla-object en)))
  ((setq en (car (vl-remove-if-not '(lambda(x)(and (wcmatch (cdadr (entget x))"INSERT")(= (acet-dxf 66 (entget x)) 1))) lstSS)))
   (setq str (vla-get-textstring (setq en(car (vlax-invoke (vlax-ename->vla-object en) 'GetAttributes)))))
  )
)
(cons en str)
)
(grtext -1 "Edit By Nguy\U+1EC5n Ng\U+1ECDc S\U+01A1n")
(setq  lstSS (acet-ss-to-list (setq ss (ssget)))
  obj (car (setq en (dowith lstSS)))
  str (cdr en)
  p1 (getpoint "\nDiem goc :")
  eL (entlast)
 oDz (getvar "Dimzin")
)
(setvar "DIMZIN" 0)
(while (setq p2 (getpoint p1 "\nDiem den :"))
(command "copy" ss "" p1 p2)
(while (setq EL (entnext EL)) (setq Listname (cons EL Listname)))
(setq  Txt1 (car (dowith listName))
  eL (entlast)
)
(Ktra)
(setvar "cecolor" "bylayer")  
(vla-put-textstring txt1
(strcat (cond ((> (setq num (+(atof str) (/ (- (cadr p2)(cadr p1)) k))) 0) "+") ; them ky thu gi truoc text sua cho nay
	((= num 0) "%%p")
	(T "")
   )
(rtos num  2 2) "m");So chu so dau dau ;
)
)
(setvar "DIMZIN" oDZ)
)
;Tim va tao moi Layer
(defun ktra ()
(if (not (tblsearch "layer" "Caodo"))
	 (command "-LAYER" "m" "Caodo" "c" 1 "Caodo" "" )
	 (setvar "clayer" "Caodo" )
)
)

     

    • Like 2

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

     

    5 giờ trước, unitiri đã nói:

    M có 2 cái lisp về block nhiều đối tượng và offset nhiều đối tượng.

    Vẫn đang dùng lâu nay như khi cài lại máy, add lại vào thì không dùng được nữa.

    Nhờ mọi người kiểm tra với ạ.

    Mình dùng cad2018.

    Thanks all!!

    anhbienbo.lsp

    offf.lsp

    Bạn này muốn đi đố mọi người hay sao chứ lips người ta đi xáo 1 mớ rồi bảo lisp e chạy bình thường

    Lips offset góc của nó đây này 

    (defun c:offf (/ _off a b d i o p s x)
  ;; RJP » 2018-11-28
  (defun _off (o d / r)
    (cond ((= 'list (type (setq r (vl-catch-all-apply 'vlax-invoke (list o 'offset d))))) (car r)))
  )
  (or (setq p (getenv "RJP_Offset_Side")) (setq p "Inside"))
  (or (setq i (getenv "RJP_Offset_Dist")) (setq i "1"))
  (or (setq b (getenv "RJP_Offset_Delete")) (setq b "No"))
  (cond
    ((and (progn (initget "Outside Inside")
		 (setq p (cond ((getkword (strcat "\nOffset [Outside/Inside] <" p ">: ")))
			       (p)
			 )
		 )
	  )
	  (setq	i (cond	((getdist (strcat "\nEnter Offset Distance: <" i ">: ")))
			((atof i))
		  )
	  )
	  (progn (initget "Yes No")
		 (setq b (cond ((getkword (strcat "\nDelete original? [Yes/No] <" b ">: ")))
			       (b)
			 )
		 )
	  )
	  (setq s (ssget ":L" '((0 . "*POLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
     )
     (setenv "RJP_Offset_Dist" (vl-princ-to-string i))
     (setenv "RJP_Offset_Side" p)
     (setenv "RJP_Offset_Delete" b)
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (setq o (vlax-ename->vla-object e))
       (cond
	 ((= 2
	     (length (setq
		       a (vl-remove
			   'nil
			   (mapcar '(lambda (x)
				      (cond ((setq d (_off o (x i))) (list d x (vlax-curve-getarea d))))
				    )
				   (list + -)
			   )
			 )
		     )
	     )
	  )
	  (setq a (vl-sort a '(lambda (r j) (< (caddr r) (caddr j)))))
	  (and (= p "Outside") (setq a (reverse a)))
	  (vla-delete (car (last a)))
	  (and (= "Yes" b) (entdel e))
	 )
	 (t (vla-put-color o 1) (print "Something went wrong.."))
       )
     )
    )
  )
  (princ)
)
(vl-load-com)

     

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

    5 giờ trước, unitiri đã nói:

    M có 2 cái lisp về block nhiều đối tượng và offset nhiều đối tượng.

    Vẫn đang dùng lâu nay như khi cài lại máy, add lại vào thì không dùng được nữa.

    Nhờ mọi người kiểm tra với ạ.

    Mình dùng cad2018.

    Thanks all!!

    anhbienbo.lsp

    offf.lsp

    Bạn xem lại file góc chứ lisp lỗi thế làm sao chạy được

    cần hỗ trợ liên hệ Zalo: 0848.998.045

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

    19 giờ trước, LD Quang hùng đã nói:

    các anh chị trong nhóm có lisp nào lấy số liệu ( cao độ, khoảng cách . lý trình,..) từ trắc ngang thiết kế từ bản vẽ thu thập được chuyển sang excel không ạ , cho em xin với , dạng như này ạ , em cảm ơn

     

    Cái này của mình nhé, lisp mất phí.

    Zalo: 0848.998.045

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

    6 phút trước, transonhai8x đã nói:

    Chào anh / chị. Em bắt đầu tìm hiểu về autolisp. Hiện em đang cần mua sách về Autolisp, nhờ anh/chị đã học trước cho em xin địa chỉ ( hoặc link ) để mua sách ( tài liệu ) học autolisp.

    Xin cảm ơn.

    Bạn ib mình gửi cuốn 1 của thầy Lộc cho nhé! nặng quá không đưa lên đây được

    zalo: 0848.998.045

    đây nhé: https://www.facebook.com/groups/205847143464966/permalink/210870346295979

    • Like 1

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

    11 giờ trước, khanhkasu đã nói:

    Chào các anh (chị) diễn đàn,

     

    Em có file notepad chứa các dòng lệnh trong máy CNC, em muốn thêm dấu chấm "." sau toạ độ X,Y như hình, 

    Mong anh (chị) giúp em với ạ.

    Cụ thể như sau ạ.

    Ví dụ: Em xuất file notepad có toạ độ là:

    N1 X125 Y905
    N2 X201 Y905
    N3 X277 Y905
    N4 X353 Y905
    N5 X429 Y905
    N6 X505 Y905
    N7 X581 Y905
    N8 X657 Y905
    N9 X733 Y905
    N10 X809 Y905
    N11 X885 Y905

    Bây giờ em muốn thêm dấu chấm "." sau toạ độ X,Y của file notepad để được kết quả như thế này ạ

    N1 X125. Y905.
    N2 X201. Y905.
    N3 X277. Y905.
    N4 X353. Y905.
    N5 X429. Y905.
    N6 X505. Y905.
    N7 X581. Y905.
    N8 X657. Y905.
    N9 X733. Y905.
    N10 X809. Y905.
    N11 X885. Y905.

     

    Mong anh chị giúp đỡ,

    Em xin cảm ơn anh (chị) nhiều.

    9007.txt

    Cái này bạn dùng excell với hàm nối text là được mà. sau đó lưu lại dưới dạng text

     

×