Viết Lisp theo yêu cầu

Tháng 1 13, 2009

Cảm ơn anh ThanhBinh vì sự nhiệt tình của anh trong câu hỏi của em, Chuyện là vậy nè hôm bữa em có qua cty mà thằng bạn em đang làm, thấy bọn nó có một lênh giống lênh MA nhưng mà nó có thể quét được các: Layer , text Style, Dim... trong block ( với sự hỗ trợ của lệnh Layiso để giữ các layer ) Mà hổng cần có đụng chạm gì vào block hết trơn. Nhưng mà xin cái lisp đó thì bên đó không cho nên viết lên đây mong aem nào cao có nhều kinh nghiệm về LISP giải quyết dùm, giúp đỡ anh em đỡ tốn trong vấn đề quản lí layer, Text style, dim.... trong một bản vẽ. Thak aem rất nhiều. :wub: :wub: :wub: :D ^_^ :D :D :D ^_^ :D :D :D :D :D

Chào bạn phamthanhungks,

Thực ra với lệnh (ssget "x") thì nó quét hầm bà lằng xắng cấu toàn bộ các thứ linh tinh trên bản vẽ chứ chả riêng gì layer, textstyle hay dim cả. Block bliếc nó xơi tuốt. Có điều với các block hay polyline thì nó chỉ quan tâm thằng bố thôi còn lũ con cháu lít nhít gọi là thuộc tính thì phải xài thêm thằng khác nên nó mới khó chịu một tí.

Nếu bạn chưa rành lắm về lisp thì đọc thêm một chút về phần các thuộc tính trong block sẽ rõ thôi. Còn nếu bạn đã rành thì việc khai thác thằng này cũng không quá phức tạp.

Mình cũng chỉ mới đang học về lisp chứ chưa thực thành thục. Mỗi lần đụng đến thằng nào thì phải giở tài liệu ra coi rồi làm thôi. Vừa làm vừa kiểm, hơi bị lâu chứ không nhanh như các bác lão làng được. Cho nên ý tưởng thì có nhưng thực hiện nó lại hơi kém. mong bạn thông cảm. Đợt này mình lại đang lu bu làm hàng cuối năm nên không rảnh để ngồi làm lisp được vì làm cái đó phải tập trung tư tưởng chứ nhấp nhổm khó làm lắm.

Vậy nên mình mới bày vậy để bạn thử coi sao.

Để ít bữa nữa thong thả mình làm thử một phát xem sao rồi gửi bạn. Tất nhiên là nó chưa chắc đúng ý bạn vì đến giờ mình cũng chưa biết chính xác cái bạn cần. Tuy nhiên mình cũng cần chút chút theo kiểu của mình gần giống với bạn nên cứ làm đã rồi chỉnh sửa sau. Việc của mình không cần gấp lắm vì nó là ngoài rìa chứ không phải việc kiếm cơm. Mình định tách các đối tượng cùng một đặc tính như line, polyline, trace, arc ..... trong các block và đưa nó về cùng một layer mang tên đặc tính đó của đối tượng bạn ạ. Sau đó có thể đổi màu đổi mè hay ẩn hiện nó cho sướng cái sự nhìn ấy mà.

Rất mong bạn hiểu và không trách mình vô tâm.

Thanks

Tháng 1 14, 2009

thak anh thanhbinh rất nhiều, chúc anh năm mới vui vẻ...Tết đến roài... ^_^

Tháng 1 16, 2009

..............
có thể quét được các: Layer , text Style, Dim... trong block ( với sự hỗ trợ của lệnh Layiso để giữ các layer ) Mà hổng cần có đụng chạm gì vào block hết trơn.

.....................

Gửi bạn LISP tui sưu tầm : có thể chuyển các đối tượng trong BLOCK về Layer 0 và color+linetype về BYLOCK.

các thuộc tính : Text Style, Dim Style ... thì "pó tay".

tên lệnh : FIXBLOCK

(defun d_FixBlock (/             eBlockSel ; Block selection
                  lInsertData ; Entity data
                  sBlockName ; Block name
                  lBlockData ; Entity data
                  eSubEntity ; Sub-entity name
                  lSubData ; Sub-entity data
                  iCount ; Counter
                 )

 ;; Redefine error handler

 (setq
   d_#error *error*
   *error*  d_FB_Error
 ) ;_ end setq

 ;; Set up environment

 (setq #SYSVARS (#SaveSysVars (list "cmdecho")))

 (setvar "cmdecho" 0)
 (command "._undo" "_group")

 ;; Get block from user and make sure it's an INSERT type

 (if (setq eBlockSel (entsel "\nSelect block to change :"))
   (progn
     (if (setq lInsertData (entget (car eBlockSel)))
       (if (= (cdr (assoc 0 lInsertData)) "INSERT")
         (setq sBlockName (cdr (assoc 2 lInsertData)))
         (progn
           (alert "Entity selected is not a block!")
           (exit)
         ) ;_ end progn
       ) ;_ end if
       (progn
         (alert "Invalid Block Selection!")
         (exit)
       ) ;_ end progn
     ) ;_ end if

     ;; Get block info from the block table

     (setq
       lBlockData (tblsearch "BLOCK" sBlockName)
       eSubEntity (cdr (assoc -2 lBlockData))
     ) ;_ end setq

     ;; Make sure block is not an Xref

     (if (not (assoc 1 lBlockData))
       (progn
         (princ "\nProcessing block: ")
         (princ sBlockName)

         (princ "\nUpdating blocks sub-entities. . .")

         ;; Parse through all of the blocks sub-entities

         (while eSubEntity

           (princ " .")
           (setq lSubData (entget eSubEntity))

           ;; Update layer property

           (if (assoc 8 lSubData)
             (progn
               (setq lSubData
                      (subst
                        (cons 8 "0")
                        (assoc 8 lSubData)
                        lSubData
                      ) ;_ end subst
               ) ;_ end setq
               (entmod lSubData)
             ) ;_ end progn
           ) ;_ end if

           ;; Update the linetype property

           (if (assoc 6 lSubData)
             (progn
               (setq lSubData
                      (subst
                        (cons 6 "BYBLOCK")
                        (assoc 6 lSubData)
                        lSubData
                      ) ;_ end subst
               ) ;_ end setq
               (entmod lSubData)
             ) ;_ end progn
             (entmod (append lSubData (list (cons 6 "BYBLOCK"))))
           ) ;_ end if

           ;; Update the color property

           (if (assoc 62 lSubData)
             (progn
               (setq lSubData
                      (subst
                        (cons 62 0)
                        (assoc 62 lSubData)
                        lSubData
                      ) ;_ end subst
               ) ;_ end setq
               (entmod lSubData)
             ) ;_ end progn
             (entmod (append lSubData (list (cons 62 0))))
           ) ;_ end if

           (setq eSubEntity (entnext eSubEntity))
   ; get next sub entity

         ) ; end while

         ;; Update attributes

         (idc_FB_UpdAttribs)

       ) ; end progn
       (alert "XREF selected. Not updated!")
     ) ; end if
   ) ; end progn
   (alert "Nothing selected.")
 ) ; end if

;;; Pop error stack and reset environment

 (idc_RestoreSysVars)

 (princ "\nDone!")

 (setq *error* d_#error)

 (princ)

)   ; end defun

   ;*******************************************************************************


   ; Function to update block attributes
   ;*******************************************************************************


(defun idc_FB_UpdAttribs ()

 ;; Update any attribute definitions

 (setq iCount 0)

 (princ "\nUpdating attributes. . .")
 (if (setq ssInserts (ssget "x"
                            (list (cons 0 "INSERT")
                                  (cons 66 1)
                                  (cons 2 sBlockName)
                            ) ;_ end list
                     ) ;_ end ssget
     ) ;_ end setq
   (repeat (sslength ssInserts)

     (setq eBlockName (ssname ssInserts iCount))

     (if (setq eSubEntity (entnext eBlockName))
       (setq
         lSubData (entget eSubEntity)
         eSubType (cdr (assoc 0 lSubData))
       ) ;_ end setq
     ) ;_ end if

     (while (or (= eSubType "ATTRIB") (= eSubType "SEQEND"))

       ;; Update layer property

       (if (assoc 8 lSubData)
         (progn
           (setq lSubData
                  (subst
                    (cons 8 "0")
                    (assoc 8 lSubData)
                    lSubData
                  ) ;_ end subst
           ) ;_ end setq
           (entmod lSubData)
         ) ;_ end progn
       ) ;_ end if

       ;; Update the linetype property

       (if (assoc 6 lSubData)
         (progn
           (setq lSubData
                  (subst
                    (cons 6 "BYBLOCK")
                    (assoc 6 lSubData)
                    lSubData
                  ) ;_ end subst
           ) ;_ end setq
           (entmod lSubData)
         ) ;_ end progn
         (entmod (append lSubData (list (cons 6 "BYBLOCK"))))
       ) ;_ end if

       ;; Update the color property

       (if (assoc 62 lSubData)
         (progn
           (setq lSubData
                  (subst
                    (cons 62 0)
                    (assoc 62 lSubData)
                    lSubData
                  ) ;_ end subst
           ) ;_ end setq
           (entmod lSubData)
         ) ;_ end progn
         (entmod (append lSubData (list (cons 62 0))))
       ) ;_ end if

       (if (setq eSubEntity (entnext eSubEntity))
         (setq
           lSubData (entget eSubEntity)
           eSubType (cdr (assoc 0 lSubData))
         ) ;_ end setq
         (setq eSubType nil)
       ) ;_ end if

     ) ; end while

     (setq iCount (1+ iCount))

   ) ; end repeat

 ) ; end if
 (command "regen")
)   ; end defun

   ;*******************************************************************************


   ; Function to save a list of system variables
   ;*******************************************************************************


(defun #SaveSysVars (lVarList / sSystemVar)
 (mapcar
   '(lambda (sSystemVar)
      (setq lSystemVars
             (append lSystemVars
                     (list (list sSystemVar (getvar sSystemVar)))
             ) ;_ end append
      ) ;_ end setq
    ) ;_ end lambda
   lVarList
 ) ;_ end mapcar

 lSystemVars

) ;_ end defun
   ;*******************************************************************************


   ; Function to restore a list of system variables
   ;*******************************************************************************


(defun idc_RestoreSysVars ()
 (mapcar
   '(lambda (sSystemVar)
      (setvar (car sSystemVar) (cadr sSystemVar))
    ) ;_ end lambda
   #SYSVARS
 ) ;_ end mapcar
) ;_ end defun
   ;*******************************************************************************


   ; Error Handler
   ;*******************************************************************************


(defun d_FB_Error (msg)

 (princ "\nError occurred in the Fix Block routine...")
 (princ "\nError: ")
 (princ msg)

 (setq *error* d_#error)
 (if *error*
   (*error* msg)
 ) ;_ end if

 (command)

 (if (/= msg "quit / exit abort")
   (progn
     (command "._undo" "_end")
     (command "._u")
   ) ;_ end progn
 ) ;_ end if

 (idc_RestoreSysVars)

 (princ)

) ;_ end defun
   ;*******************************************************************************



(defun C:FIXBLOCK () (d_FixBlock))
(princ)

Tháng 1 17, 2009

Chào các bác. Các bác giúp em cáu lisp vẽ bánh răng thân khai. sau đó sếp cho ăn khớp đúng va cho quay theo tốc độ nhập vào với . Xin cám ơn!

Tháng 1 24, 2009

chào các bác, em cũng là lính mới tò te trong lisp,em đang dùng cad2004,em muốn bác nào giúp em viết 1 cái lisp đơn giản để em có thể tự mày mò đươc không, đặt phím Q cho lệnh copy với chức năng multiple nữa nhé,em viết rồi nhưng được mỗi lệnh copy ra 1 đối tượng thôi, còn để copy ra nhiều đối tượng thì lại phải chon chức năng multiple.Mong đưọc sự giúp đỡ của các Bro

Tháng 2 1, 2009

chào các bác, em cũng là lính mới tò te trong lisp,em đang dùng cad2004,em muốn bác nào giúp em viết 1 cái lisp đơn giản để em có thể tự mày mò đươc không, đặt phím Q cho lệnh copy với chức năng multiple nữa nhé,em viết rồi nhưng được mỗi lệnh copy ra 1 đối tượng thôi, còn để copy ra nhiều đối tượng thì lại phải chon chức năng multiple.Mong đưọc sự giúp đỡ của các Bro

Các dạng này rất đơn giản. Bạn tìm hiểu các yêu cầu của lệnh AutoCAD, đưa vào biểu thức command là xong. Cụ thể:

(defun C:Q() (command "copy" (ssget) "" "m" pause))

Diễn giải:

(command "copy" -> gõ lệnh copy và Enter

(ssget) -> chọn đối tượng

"" -> Enter, chấm dứt động tác chọn

"m" -> tương đương với gõ m (multiple) và Enter

pause) -> trả quyền điều khiển cho AutoCAD

Tháng 2 1, 2009

Cám ơn SSq nhé,mình làm được rồi,đúng là học thầy không tay học bạn,mình sẽ tu mày mò tìm hiểu thêm.

Tháng 2 3, 2009

Em muốn chèn Block theo 1 file toạ độ (dạng text), Bác nào biết chỉ dùm

Tháng 2 3, 2009

Em muốn chèn Block theo 1 file toạ độ (dạng text), Bác nào biết chỉ dùm

Hãy up 1 file txt chứa tọa độ và nêu yêu cầu cụ thể xem! Bạn muốn chèn block gì do bạn chỉ định hay gì gì, Sau khi chèn thì có làm gì không (tỉ lệ, góc quay, layer, chú thích)

Tháng 2 4, 2009

Hãy up 1 file txt chứa tọa độ và nêu yêu cầu cụ thể xem! Bạn muốn chèn block gì do bạn chỉ định hay gì gì, Sau khi chèn thì có làm gì không (tỉ lệ, góc quay, layer, chú thích)

Mình muốn import block được chỉ định theo 1 file toạ độ, định dạng file toạ độ http://www.cadviet.com/upfiles/toa_do.xls (định dạng file gồm tọa độ x,y). Còn về tỷ lệ, góc quay... thì không cần thiết lắm.

Tháng 2 4, 2009

Gửi bạn LISP tui sưu tầm : có thể chuyển các đối tượng trong BLOCK về Layer 0 và color+linetype về BYLOCK.

các thuộc tính : Text Style, Dim Style ... thì "pó tay".

tên lệnh : FIXBLOCK

(defun d_FixBlock (/             eBlockSel ; Block selection
                  lInsertData ; Entity data
                  sBlockName ; Block name
                  lBlockData ; Entity data
                  eSubEntity ; Sub-entity name
                  lSubData ; Sub-entity data
                  iCount ; Counter
                 )

 ;; Redefine error handler

 (setq
   d_#error *error*
   *error*  d_FB_Error
 ) ;_ end setq

 ;; Set up environment

 (setq #SYSVARS (#SaveSysVars (list "cmdecho")))

 (setvar "cmdecho" 0)
 (command "._undo" "_group")

 ;; Get block from user and make sure it's an INSERT type

 (if (setq eBlockSel (entsel "\nSelect block to change :"))
   (progn
     (if (setq lInsertData (entget (car eBlockSel)))
       (if (= (cdr (assoc 0 lInsertData)) "INSERT")
         (setq sBlockName (cdr (assoc 2 lInsertData)))
         (progn
           (alert "Entity selected is not a block!")
           (exit)
         ) ;_ end progn
       ) ;_ end if
       (progn
         (alert "Invalid Block Selection!")
         (exit)
       ) ;_ end progn
     ) ;_ end if

     ;; Get block info from the block table

     (setq
       lBlockData (tblsearch "BLOCK" sBlockName)
       eSubEntity (cdr (assoc -2 lBlockData))
     ) ;_ end setq

     ;; Make sure block is not an Xref

     (if (not (assoc 1 lBlockData))
       (progn
         (princ "\nProcessing block: ")
         (princ sBlockName)

         (princ "\nUpdating blocks sub-entities. . .")

         ;; Parse through all of the blocks sub-entities

         (while eSubEntity

           (princ " .")
           (setq lSubData (entget eSubEntity))

           ;; Update layer property

           (if (assoc 8 lSubData)
             (progn
               (setq lSubData
                      (subst
                        (cons 8 "0")
                        (assoc 8 lSubData)
                        lSubData
                      ) ;_ end subst
               ) ;_ end setq
               (entmod lSubData)
             ) ;_ end progn
           ) ;_ end if

           ;; Update the linetype property

           (if (assoc 6 lSubData)
             (progn
               (setq lSubData
                      (subst
                        (cons 6 "BYBLOCK")
                        (assoc 6 lSubData)
                        lSubData
                      ) ;_ end subst
               ) ;_ end setq
               (entmod lSubData)
             ) ;_ end progn
             (entmod (append lSubData (list (cons 6 "BYBLOCK"))))
           ) ;_ end if

           ;; Update the color property

           (if (assoc 62 lSubData)
             (progn
               (setq lSubData
                      (subst
                        (cons 62 0)
                        (assoc 62 lSubData)
                        lSubData
                      ) ;_ end subst
               ) ;_ end setq
               (entmod lSubData)
             ) ;_ end progn
             (entmod (append lSubData (list (cons 62 0))))
           ) ;_ end if

           (setq eSubEntity (entnext eSubEntity))
   ; get next sub entity

         ) ; end while

         ;; Update attributes

         (idc_FB_UpdAttribs)

       ) ; end progn
       (alert "XREF selected. Not updated!")
     ) ; end if
   ) ; end progn
   (alert "Nothing selected.")
 ) ; end if

;;; Pop error stack and reset environment

 (idc_RestoreSysVars)

 (princ "\nDone!")

 (setq *error* d_#error)

 (princ)

)   ; end defun

   ;*******************************************************************************

   ; Function to update block attributes
   ;*******************************************************************************

(defun idc_FB_UpdAttribs ()

 ;; Update any attribute definitions

 (setq iCount 0)

 (princ "\nUpdating attributes. . .")
 (if (setq ssInserts (ssget "x"
                            (list (cons 0 "INSERT")
                                  (cons 66 1)
                                  (cons 2 sBlockName)
                            ) ;_ end list
                     ) ;_ end ssget
     ) ;_ end setq
   (repeat (sslength ssInserts)

     (setq eBlockName (ssname ssInserts iCount))

     (if (setq eSubEntity (entnext eBlockName))
       (setq
         lSubData (entget eSubEntity)
         eSubType (cdr (assoc 0 lSubData))
       ) ;_ end setq
     ) ;_ end if

     (while (or (= eSubType "ATTRIB") (= eSubType "SEQEND"))

       ;; Update layer property

       (if (assoc 8 lSubData)
         (progn
           (setq lSubData
                  (subst
                    (cons 8 "0")
                    (assoc 8 lSubData)
                    lSubData
                  ) ;_ end subst
           ) ;_ end setq
           (entmod lSubData)
         ) ;_ end progn
       ) ;_ end if

       ;; Update the linetype property

       (if (assoc 6 lSubData)
         (progn
           (setq lSubData
                  (subst
                    (cons 6 "BYBLOCK")
                    (assoc 6 lSubData)
                    lSubData
                  ) ;_ end subst
           ) ;_ end setq
           (entmod lSubData)
         ) ;_ end progn
         (entmod (append lSubData (list (cons 6 "BYBLOCK"))))
       ) ;_ end if

       ;; Update the color property

       (if (assoc 62 lSubData)
         (progn
           (setq lSubData
                  (subst
                    (cons 62 0)
                    (assoc 62 lSubData)
                    lSubData
                  ) ;_ end subst
           ) ;_ end setq
           (entmod lSubData)
         ) ;_ end progn
         (entmod (append lSubData (list (cons 62 0))))
       ) ;_ end if

       (if (setq eSubEntity (entnext eSubEntity))
         (setq
           lSubData (entget eSubEntity)
           eSubType (cdr (assoc 0 lSubData))
         ) ;_ end setq
         (setq eSubType nil)
       ) ;_ end if

     ) ; end while

     (setq iCount (1+ iCount))

   ) ; end repeat

 ) ; end if
 (command "regen")
)   ; end defun

   ;*******************************************************************************

   ; Function to save a list of system variables
   ;*******************************************************************************

(defun #SaveSysVars (lVarList / sSystemVar)
 (mapcar
   '(lambda (sSystemVar)
      (setq lSystemVars
             (append lSystemVars
                     (list (list sSystemVar (getvar sSystemVar)))
             ) ;_ end append
      ) ;_ end setq
    ) ;_ end lambda
   lVarList
 ) ;_ end mapcar

 lSystemVars

) ;_ end defun
   ;*******************************************************************************

   ; Function to restore a list of system variables
   ;*******************************************************************************

(defun idc_RestoreSysVars ()
 (mapcar
   '(lambda (sSystemVar)
      (setvar (car sSystemVar) (cadr sSystemVar))
    ) ;_ end lambda
   #SYSVARS
 ) ;_ end mapcar
) ;_ end defun
   ;*******************************************************************************

   ; Error Handler
   ;*******************************************************************************

(defun d_FB_Error (msg)

 (princ "\nError occurred in the Fix Block routine...")
 (princ "\nError: ")
 (princ msg)

 (setq *error* d_#error)
 (if *error*
   (*error* msg)
 ) ;_ end if

 (command)

 (if (/= msg "quit / exit abort")
   (progn
     (command "._undo" "_end")
     (command "._u")
   ) ;_ end progn
 ) ;_ end if

 (idc_RestoreSysVars)

 (princ)

) ;_ end defun
   ;*******************************************************************************

(defun C:FIXBLOCK () (d_FixBlock))
(princ)

Chào các Bác em là lính mới thấy cái fixblock này hay nhưng có cái là không chọn được nhiều Block cùng 1 lúc, các bác viết hoàn thiện để chọn được nhiều block với

Tháng 2 4, 2009

Em có cái này nhờ các bác giúp:

Mình nhờ các bạn lập dùm cho mình lisp vẽ hình chữ nhật, điền tên(vào chính giữa hình chữ nhật), tô hatch tự động trên cơ sở toạ độ của hai đỉnh đối diện của hình chữ nhật. Cấu tạo file SL

Ten X1 Y1 X2 Y2

1.S 100.00 -4.50 109.30 4.50

2.S 109.30 -5.00 125.10 -1.00

3.RN 109.30 1.00 125.10 5.00

4.S 125.10 -5.00 137.90 0.00

5.S 125.10 2.00 137.90 5.00

6.S 137.90 0.00 152.10 4.00

7.G 137.90 -4.60 142.30 -1.00

8.S 142.30 -4.50 158.90 -0.50

9.RN 152.10 0.60 158.90 4.60

10.S 158.90 -5.60 162.90 -2.00

11.S 158.90 1.00 180.70 5.00

12.LT 169.90 -4.00 180.70 0.00

13.S 180.70 -4.50 196.90 4.50

14.S 196.90 -4.50 203.70 4.50

15.VL 203.70 -4.80 211.70 -0.80

16.S 203.70 0.60 225.20 4.60

17.S 225.20 -4.50 243.70 4.50

18.RN 243.70 -4.50 251.70 4.50

Với mối loại ký hiệu (S,VL, RN, G ...) thì các tên, hình chữ nhật, hatch ở lớp có tên tương tự

Đây la file minh vẽ nhưng chưa tô hatch:

http://www.cadviet.com/upfiles/untitled_55.bmp

Tháng 2 5, 2009

Chào các Bác em là lính mới thấy cái fixblock này hay nhưng có cái là không chọn được nhiều Block cùng 1 lúc, các bác viết hoàn thiện để chọn được nhiều block với

Cái này sẽ giúp bạn làm được điều đấy:

Lệnh SB sẽ đưa nhóm block bạn chọn về tiêu chuẩn (theo tôi by block là tiêu chuẩn)

Lệnh SSB sẽ đưa tất cả các block của bản vẽ về tiêu chuẩn mà không cần phải chọn (kể cả các Block không được insert trong bản vẽ)

MakeStandardBlock

Tháng 2 5, 2009

Chào các bác. Các bác giúp em cáu lisp vẽ bánh răng thân khai. sau đó sếp cho ăn khớp đúng va cho quay theo tốc độ nhập vào với . Xin cám ơn!

Chào bạn Vinhlun,

Theo yêu cầu của bạn, mình thiết nghĩ lisp chỉ có thể làm được một phần là vẽ bánh răng thân khai còn việc mô phỏng chuyển động của cặp bánh răng thì mình chưa thấy nói đến.

Nếu đó là nhu cầu bắt buộc thì theo mình bạn có thể làm phần mô phỏng trên SolidWorks sẽ đơn giản và thuận lợi hơn nhiều.

Rất mong bạn thành công.

Tháng 2 5, 2009

LISP P2T.lsp của CADViet chỉ đánh Số thứ tự từ Trái qua Phải và Trên xuống Duới. Nhờ các Bác bổ sung thêm các options để:

+ Cho phép đánh cả Chử + Số +Chử (TD: X1a, X2a, X3a...)

+ Theo hướng user chọn

+ Dọc theo Line/Pline đi qua các points.

Thanks you.

(defun c:P2T (/ sst lstent pp p soht strht)
(defun ss2ent (ss / sodt index lstent)
(princ "\nCADViet.com © 2007")
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun getp (ent)
(cdr (assoc 10 (entget ent)))
)
(defun sosanh (ent1 ent2 / p1 p2 x1 y1 x2 y2)
(setq
p1 (getp ent1)
x1 (car p1)
y1 (cadr p1)
p2 (getp ent2)
x2 (car p2)
y2 (cadr p2)
)
(or (< x1 x2)
(and (= x1 x2) (< y1 y2))
)
)

;;------------- Main -------------------------------
(princ "\nPoint to Text © 2007 CADViet.com")
(setq
sst (ssget '((0 . "POINT")))
caochu (getdist "\nVao chieu cao text: ")
soht (1- (getint "\nVao so bat dau danh: "))
lstent (vl-sort (ss2ent sst) 'sosanh)
)
(foreach pp lstent
(setq
soht (1+ soht)
strht (itoa soht)
p (getp pp)
)
(entmake
(list
(cons 0 "TEXT")
(cons 10 P)
(cons 40 caochu)
(cons 1 strht)
)
)
)
(princ)
)
(princ "\nSu dung lenh P2T bat dau")
(princ "\nfree lisp from www.cadviet.com")
(princ)

Tháng 2 5, 2009

Nhờ các bác sửa giúp lệnh này lisp tôi viết theo kiểu lệnh vẽ nhưng bị lỗi

(command "CIRCLE" "0,0" "0.2" "")

(command "CIRCLE" "100,0" "0.2" "")

(command "CIRCLE" "200,0" "0.2" "")

Tháng 2 7, 2009

Nhờ các bác sửa giúp lệnh này lisp tôi viết theo kiểu lệnh vẽ nhưng bị lỗi
(command "CIRCLE" "0,0" "0.2" "")

(command "CIRCLE" "100,0" "0.2" "")

(command "CIRCLE" "200,0" "0.2" "")

Chào bạn Haiduong2105,

Bạn viết lisp như vậy là sai về cú pháp nên nó không chạy được.

Bạn nhớ rằng các ký tự bên trong dấu ngoặc kép được hiểu là chuỗi ký tự nhập từ bàn phím chứ không phải là một danh sách chỉ tọa độ điểm tâm vòng tròn cũng như một giá trị số của bán kính vòng tròn theo như yêu cầu của lệnh Circle. Các phần tử của một danh sách được ngăn cách bởi các khoảng trắng chứ không phải bởi dấu "," . Do vậy cái lisp của bạn cần sửa lại như sau:

(command "circle" '(0 0) 0.2)

(command "circle" (list 100 0) 0.2)

(command "circle" '(200 0) 0.2)

Chúc bạn thành công.

Tháng 2 7, 2009

Chưa có ai giúp chắc vì còn Tết.

Lisp num.lsp này cho phép đánh cả Chử + Số +Chử (TD: X1a, X2a, X3a...)

Nếu thêm được vào option để cho phép đánh theo cấp số nhân thì hay hơn (TD: +5m, +10m, +15m...)

Lệnh NUM

;; =============================================================	;;
;;                                                               	;;
;;  NUM.LSP - This program for fast dynamic numbering. To number a 	;;
;;             suffix and a prefix can be added.     			;;
;;                                                               	;;
;; ==================================================================== ;;
;;                                                               	;;
;;  Command(s) to call: NUM                                    		;;
;;                                                               	;;
;;  Specify the text size, a suffix, a prefix and starting number   	;;
;;  (for erase the old suffix or prefix you should press Spacebar).	;;
;;  Insert a numbers or press Esc to quit. The program remembers old	;;
;;  properties and it is possible to confirm it pressing of Spacebar	;;
;;  key.								;;
;;                                                               	;;
;; ====================================================================	;;
;;                                                               	;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY   	;;
;;  MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR  	;;
;;  PARTS OF IT ABSOLUTELY FREE.                 			;;
;;                                                               	;;
;;  THIS PROGRAM PROVIDES THIS PROGRAM 'AS IS' WITH ALL FAULTS AND  	;;
;;  SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY     	;;
;;  OR FITNESS FOR A PARTICULAR USE.             			;;
;;                                                               	;;
;; ====================================================================	;;
;;                                                               	;;
;;  V1.3, 12 May, 2005, Riga, Latvia                                  	;;
;;  © Aleksandr Smirnov (ASMI)                          	   	;;
;;  For AutoCAD 2000 - 2008 (isn't tested in a next versions)		;;
;;                                                               	;;
;;                                      [url="http://www.asmitools.com"]http://www.asmitools.com[/url]   	;;
;;								 	;;
;; ====================================================================	;;


(defun c:num (/ oldPref oldSuf oldStart curStr newNum 
               actDoc actSp oldEcho oldSize *error*) 

 (defun *error* (msg) 
   (setvar "CMDECHO" oldEcho) 
   (princ) 
   ); end *error* 

 (vl-load-com) 
 (if(not num:Size)(setq num:Size(getvar "DIMTXT"))) 
 (if(not num:Pref)(setq num:Pref "")) 
 (if(not num:Suf)(setq num:Suf "")) 
 (if(not num:Num)(setq num:Num 1)) 
 (setq oldPref num:Pref 
       oldSuf num:Suf 
       oldStart num:Num 
       oldSize num:Size 
       actDoc(vla-get-ActiveDocument 
               (vlax-get-acad-object)) 
       oldEcho(getvar "CMDECHO") 
  ); end setq 
 (setvar "CMDECHO" 0) 
 (if(=(vla-get-ActiveSpace actDoc)1) 
        (setq actSp(vla-get-ModelSpace actDoc)) 
        (setq actSp(vla-get-PaperSpace actDoc)) 
   ); end if
 (setq num:Size 
   (getreal 
     (strcat "\nText size <"(rtos num:Size)">: "))) 
 (if(null num:Size)(setq num:Size oldSize)) 
 (setq num:Pref 
   (getstring T 
     (strcat "\nPrefix: <"num:Pref">: "))) 
 (if(= "" num:Pref)(setq num:Pref oldPref)) 
 (if(= " " num:Pref)(setq num:Pref "")) 
 (setq num:Suf 
   (getstring T 
     (strcat "\nSuffix: <"num:Suf">: "))) 
 (if(= "" num:Suf)(setq num:Suf oldSuf)) 
 (if(= " " num:Suf)(setq num:Suf "")) 
 (setq num:Num 
   (getint 
     (strcat "\nStarting number <"(itoa num:Num)">: "))) 
 (if(null num:Num)(setq num:Num oldStart))
 (princ "\n<<< Insert numbers or press Esc to quit >>> ")
     (while T 
       (setq curStr(strcat num:Pref(itoa num:Num)num:Suf) 
             newNum(vla-AddText actSp 
             curStr (vlax-3d-point '(0.0 0.0 0.0)) num:Size)) 
       (vla-put-Alignment newNum acAlignmentMiddleCenter) 
       (command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"") 
       (command "_.erase" (entlast) "") 
       (command "_.pasteclip" pause) 
       (setq num:Num(1+ num:Num)) 
      ); end while 
 (princ) 
); end of c:num

(princ "\n*** Dynamic numbering tool. Type NUM to run.*** ")

... nhưng phải select từng point, không được như P2T.lsp

LISP P2T.lsp của CADViet chỉ đánh Số thứ tự từ Trái qua Phải và Trên xuống Duới. Nhờ các Bác bổ sung thêm các options để:

+ Cho phép đánh cả Chử + Số +Chử (TD: X1a, X2a, X3a...)

+ Theo hướng user chọn

+ Dọc theo Line/Pline đi qua các points.

Thanks you.

(defun c:P2T (/ sst lstent pp p soht strht)
(defun ss2ent (ss / sodt index lstent)
(princ "\nCADViet.com © 2007")
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun getp (ent)
(cdr (assoc 10 (entget ent)))
)
(defun sosanh (ent1 ent2 / p1 p2 x1 y1 x2 y2)
(setq
p1 (getp ent1)
x1 (car p1)
y1 (cadr p1)
p2 (getp ent2)
x2 (car p2)
y2 (cadr p2)
)
(or (< x1 x2)
(and (= x1 x2) (< y1 y2))
)
)

;;------------- Main -------------------------------
(princ "\nPoint to Text © 2007 CADViet.com")
(setq
sst (ssget '((0 . "POINT")))
caochu (getdist "\nVao chieu cao text: ")
soht (1- (getint "\nVao so bat dau danh: "))
lstent (vl-sort (ss2ent sst) 'sosanh)
)
(foreach pp lstent
(setq
soht (1+ soht)
strht (itoa soht)
p (getp pp)
)
(entmake
(list
(cons 0 "TEXT")
(cons 10 P)
(cons 40 caochu)
(cons 1 strht)
)
)
)
(princ)
)
(princ "\nSu dung lenh P2T bat dau")
(princ "\nfree lisp from www.cadviet.com")
(princ)

Tháng 2 7, 2009

Chào bạn Haiduong2105,
Bạn viết lisp như vậy là sai về cú pháp nên nó không chạy được.

Bạn nhớ rằng các ký tự bên trong dấu ngoặc kép được hiểu là chuỗi ký tự nhập từ bàn phím chứ không phải là một danh sách chỉ tọa độ điểm tâm vòng tròn cũng như một giá trị số của bán kính vòng tròn theo như yêu cầu của lệnh Circle. Các phần tử của một danh sách được ngăn cách bởi các khoảng trắng chứ không phải bởi dấu "," . Do vậy cái lisp của bạn cần sửa lại như sau:

(command "circle" '(0 0) 0.2)

(command "circle" (list 100 0) 0.2)

(command "circle" '(200 0) 0.2)

Chúc bạn thành công.

Chào bạn phamthanhbinh

Rất cám ơn bạn mình đã sửa được rồi. Bạn có thể giúp mình viết lệnh tố hatch tự động theo kiểu cú pháp trên.

cơ sở là có 2 toạ độ của 2 góc đối diện của hình chữ nhật (ví dụ toạ độ: 0,0 và 5,5)

mình đang viết một một tiệ ích nhỏ trên excel và xuất ra lisp để chậy trên cad, nhưng chưa nghĩ ra cách viết lệnh hatch.

Mong bạn giúp đỡ

Tháng 2 7, 2009

Chào bạn phamthanhbinh
Rất cám ơn bạn mình đã sửa được rồi. Bạn có thể giúp mình viết lệnh tố hatch tự động theo kiểu cú pháp trên.

cơ sở là có 2 toạ độ của 2 góc đối diện của hình chữ nhật (ví dụ toạ độ: 0,0 và 5,5)

mình đang viết một một tiệ ích nhỏ trên excel và xuất ra lisp để chậy trên cad, nhưng chưa nghĩ ra cách viết lệnh hatch.

Mong bạn giúp đỡ

Chào bạn Haiduong2105,

Vì không biết bạn yêu cầu hatch kiểu gì nên mình gửi bạn đoạn lisp sau đây dùng để hatch một polyline khép kín. Bạn có thể căn cứ vào đó để sửa theo yêu cầu cụ thể của bạn.

(command "hatch" "ansi31" 10 0 (entsel))

Đoạn lisp này sử dụng kiểu hatch là kiểu ansi31 với tỷ lệ phóng mẫu là 10 và góc nghiêng mẫu là 0 độ. Đối tượng được chọn phải là một polyline khép kín.

Chúc bạn thành công.

Tháng 2 7, 2009

Bạn có thể giúp mình viết lệnh tố hatch tự động theo kiểu cú pháp trên.
cơ sở là có 2 toạ độ của 2 góc đối diện của hình chữ nhật (ví dụ toạ độ: 0,0 và 5,5)

mình đang viết một một tiệ ích nhỏ trên excel và xuất ra lisp để chậy trên cad, nhưng chưa nghĩ ra cách viết lệnh hatch.

Mong bạn giúp đỡ

Đoạn Lisp này sẽ giúp bạn thực hiện điều đó.

Khi chạy bạn chọn 2 điểm là 2 góc đối diện của hình chữ nhật và Lisp sẽ tự động Hatch vào hình chữ nhật này.

Đoạn lisp này sử dụng kiểu hatch là kiểu ansi31 với tỷ lệ phóng mẫu là 10 và góc nghiêng mẫu là 0 độ.

(defun c:TOH()
(prompt "\n Nhap 2 toa do la 2 goc doi dien cua hinh chu nhat :")
(setq dc1 (getpoint "\nNhap diem thu nhat :"))
(setq dc2 (getpoint dc1"\nNhap diem thu 2 :"))
(setq dc3 (list(car dc2) (cadr dc1)))
(setq dc4 (list(car dc1) (cadr dc2)))
(command "hatch" "ansi31" "10" "0" "" "y" dc1 dc3 dc2 dc4 "c" "")
(princ)
)

Hy vọng Lisp chạy đúng ý bạn.

Tháng 2 9, 2009

Bạn có thể post yêu cầu về autolisp ở topic này.

Chào các bác.

Tôi muốn xin một lệnh dùng để bo tròn các đỉnh của các polyline.

Các buớc thực hiện như sau :

1-nhập lệnh

2-nhập bán kính bẻ cong. Nếu nhấn enter thì lấy giá trị cũ.

3-chọn các đối tượng là polyline

4-enter kết thúc lệnh.

Xem file kèm theo :

http://www.cadviet.com/upfiles/Question.dwg

Thanks!!!!!!!!!!!!!!!!!!!

Tháng 2 9, 2009

Lệnh Fillet (F) hoàn toàn có thể giải quyết cho bạn vấn đề này

F enter - chọn R (Nhập vào bán kính cong) - Chọn P enter - quét chọn PL của bạn - enter -> xong

Chú ý kích thước của R phải phù hơp.

Tháng 2 9, 2009

chào các bác, e muốn xin các bác có cái lisp nào có thể làm đc như sau kô ah :

khi click vào text ( DT ) thì tự động chuyển thành chữ có bạch chân ( Bold) làm được với multy thì tốt wa các bác ah. e cảm ơn các bác nhiều

Tháng 2 9, 2009

Chào bạn Tue_NV và bạn phamthanhbinh!

Rất cán ơn hai bạn đã quan tâm giúp đỡ mình đã làm được rồi.

Đăng nhập

Viết Lisp theo yêu cầu

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

phamthanhbinh 3.146

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

phamthanhhungks 19

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.548

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

vinhlun 0

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

vminh_ct 5

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

ssg 1.102

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

vminh_ct 5

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

baodenhp 0

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.518

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

baodenhp 0

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

haiduong2105 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

haiduong2105 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

nataca 554

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

phamthanhbinh 3.146

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

Phiphi- 176

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

haiduong2105 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

phamthanhbinh 3.146

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

Phiphi- 176

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

haiduong2105 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

phamthanhbinh 3.146