Đến nội dung


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

Viết Lisp theo yêu cầu


  • Chủ đề bị khóa Chủ đề bị khóa
2780 replies to this topic

#1501 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 13 January 2009 - 05:28 PM

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
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1502 phamthanhhungks

phamthanhhungks

    biết vẽ polygon

  • Members
  • PipPip
  • 74 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 14 January 2009 - 08:35 AM

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

#1503 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 16 January 2009 - 01:39 PM

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

  • 2

#1504 vinhlun

vinhlun

    biết pan

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

Đã gửi 17 January 2009 - 01:49 PM

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!
  • 0

#1505 vminh_ct

vminh_ct

    biết lệnh stretch

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

Đã gửi 25 January 2009 - 12:06 AM

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
  • 0
" Sống trên đời cần có 1 tấm lòng,để gió mãi cuốn đi"

#1506 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 01 February 2009 - 09:51 AM

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
  • 0

#1507 vminh_ct

vminh_ct

    biết lệnh stretch

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

Đã gửi 01 February 2009 - 08:32 PM

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.
  • 0
" Sống trên đời cần có 1 tấm lòng,để gió mãi cuốn đi"

#1508 baodenhp

baodenhp

    biết vẽ arc

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

Đã gửi 03 February 2009 - 10:23 AM

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

#1509 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 03 February 2009 - 10:35 AM

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)
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#1510 baodenhp

baodenhp

    biết vẽ arc

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

Đã gửi 04 February 2009 - 04:03 PM

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.c...iles/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.
  • 0

#1511 haiduong2105

haiduong2105

    biết zoom

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

Đã gửi 05 February 2009 - 12:27 AM

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
  • 0

#1512 haiduong2105

haiduong2105

    biết zoom

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

Đã gửi 05 February 2009 - 01:49 AM

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.c...untitled_55.bmp
  • 0

#1513 nataca

nataca

    biết lệnh adcenter

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

Đã gửi 05 February 2009 - 11:26 AM

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
  • 0

#1514 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 05 February 2009 - 12:08 PM

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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1515 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 05 February 2009 - 08:01 PM

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)

  • 0

#1516 haiduong2105

haiduong2105

    biết zoom

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

Đã gửi 05 February 2009 - 10:46 PM

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" "")
  • 0

#1517 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 07 February 2009 - 12:05 PM

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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#1518 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 07 February 2009 - 12:18 PM

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)


  • 0

#1519 haiduong2105

haiduong2105

    biết zoom

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

Đã gửi 07 February 2009 - 06:19 PM

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 đỡ
  • 0

#1520 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 07 February 2009 - 07:24 PM

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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.