Đến nội dung


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

[Đã xong] Lisp rải đối tượng theo đơờng dẩn.


  • Please log in to reply
88 replies to this topic

#21 tpthainguyen

tpthainguyen

    biết zoom

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

Đã gửi 31 May 2011 - 09:17 AM

e là e rất thích những lips rải với xoay đối tượng như thế này, nhưng e ko sao dùng được cho đối tượng là block, có ai bị lỗi giống như em ko ạ, ko dùng được lips này, e cứ phải ngồi xoay từng cái một, huhu
  • 0

#22 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 31 May 2011 - 09:30 AM

e là e rất thích những lips rải với xoay đối tượng như thế này, nhưng e ko sao dùng được cho đối tượng là block, có ai bị lỗi giống như em ko ạ, ko dùng được lips này, e cứ phải ngồi xoay từng cái một, huhu

-Mình đến khóc thét lên chứ không hu hu nổi nửa khi nghe bạn ngồi "xoay từng cái một".
-Nếu với đối tượng lẻ mà nó được thì về nguyên tắc block nó cũng được <_< . Bạn gửi cái file bạn rải cho mình dòm ngó cái block của bạn tí hen!
  • 1

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


#23 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 31 May 2011 - 02:11 PM

Em giới thiệu thêm lisp rải đối tượng của alanjt nữa, code cũng ngắn ngắn, nhưng có hàm con mót được ^^, bác Duy thử dùng và hoàn thiện tiếp cái RDT nhé. Bravo
(defun c:CAC (/) (c:CopyAlongCurve))
(defun c:CopyAlongCurve (/ *error* AT:Entsel AT:DrawX AT:ClosestEndPoint _angle _cmr _Points _PLine
#SS #Pnt #Ent #PLine #Obj #Num #Seg #Add #Dist #Val #Cnt #TempPnt #TempObj
#Temp #List #Rot #Ang
)


;;; error handler
(defun *error* (#Message)
(redraw)
(and #PLine
(if (vl-catch-all-error-p (vl-catch-all-apply (function vla-delete) (list #PLine)))
(alert "Temporary LWPolyline could not be deleted!")
) ;_ if
) ;_ and
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(and #Message
(not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*"))
(princ (strcat "\nError: " #Message))
) ;_ and
) ;_ defun




;;; Entsel or NEntsel with options
;;; #Nested - Entsel or Nentsel (T for Nentsel, nil for Entsel)
;;; #Message - Selection message (if nil, "\nSelect object: " is used)
;;; #FilterList - DXF ssget style filtering (nil if not required)
;;; "V" as first item in list to convert object to VLA-OBJECT (must be in list if no DXF filtering)
;;; "L" as first item in list to ignore locked layers (must be in list if no DXF filtering)
;;; #Keywords - Keywords to match instead of object selection (nil if not required)
;;; Example: (AT:Entsel nil "\nSelect MText not on 0 layer [Settings]: " '("LV" (0 . "MTEXT")(8 . "~0")) "Settings")
;;; Example: (AT:Entsel T "\nSelect object [Settings]: " '("LV") "Settings")
;;; Alan J. Thompson, 04.16.09
;;; Updated: Alan J. Thompson, 06.04.09 (changed filter coding to work as ssget style dxf filtering)
;;; Updated: Alan J. Thompson, 09.07.09 (added option to ignore locked layers and convert object to VLA-OBJECT
;;; Updated: Alan J. Thompson, 09.18.09 (fixed 'missed pick' alert)
(defun AT:Entsel (#Nested #Message #FilterList #Keywords / #Count #Message #Choice #Ent
#VLA&Locked #FilterList
)
(vl-load-com)
(setvar "errno" 0)
(setq #Count 0)
;; fix message
(or #Message (setq #Message "\nSelect object: "))
;; set entsel/nentsel
(if #Nested
(setq #Choice nentsel)
(setq #Choice entsel)
) ;_ if
;; check if option to convert to vla-object or ignore locked layers in #FilterList variable
(and (vl-consp #FilterList)
(eq (type (car #FilterList)) 'STR)
(setq #VLA&Locked (car #FilterList)
#FilterList (cdr #FilterList)
) ;_ setq
) ;_ and
;; select object
(while (and (not #Ent) (/= (getvar "errno") 52))
;; if keywords
(and #Keywords (initget #Keywords))
(cond
((setq #Ent (#Choice #Message))
;; if ignore locked layers
(and #VLA&Locked
(vl-consp #Ent)
(wcmatch (strcase #VLA&Locked) "*L*")
(not
(zerop
(cdr (assoc 70
(entget (tblobjname
"layer"
(cdr (assoc 8 (entget (car #Ent))))
) ;_ tblobjname
) ;_ entget
) ;_ assoc
) ;_ cdr
) ;_ zerop
) ;_ not
(setq #Ent nil
#Flag T
) ;_ setq
) ;_ and
;; #FilterList check
(if (and #FilterList (vl-consp #Ent))
;; process filtering from #FilterList
(or
(not
(member
nil
(mapcar '(lambda (x)
(wcmatch
(strcase
(vl-princ-to-string
(cdr (assoc (car x) (entget (car #Ent))))
) ;_ vl-princ-to-string
) ;_ strcase
(strcase (vl-princ-to-string (cdr x)))
) ;_ wcmatch
) ;_ lambda
#FilterList
) ;_ mapcar
) ;_ member
) ;_ not
(setq #Ent nil
#Flag T
) ;_ setq
) ;_ or
) ;_ if
)
) ;_ cond
(and (or (= (getvar "errno") 7) #Flag)
(/= (getvar "errno") 52)
(not #Ent)
(setq #Count (1+ #Count))
(prompt (strcat "\nNope, keep trying! "
(itoa #Count)
" missed pick(s)."
) ;_ strcat
) ;_ prompt
) ;_ and
) ;_ while
(if (and (vl-consp #Ent)
#VLA&Locked
(wcmatch (strcase #VLA&Locked) "*V*")
) ;_ and
(vlax-ename->vla-object (car #Ent))
#Ent
) ;_ if
) ;_ defun



;;; Draw and "X" vector at specified point
;;; P - Placement point for "X"
;;; C - Color of "X" (must be integer b/w 1 & 255)
;;; Alan J. Thompson, 10.31.09 / 03.26.10
(defun AT:DrawX (P C / d)
(if (and (vl-consp P)
(setq d (* (getvar "VIEWSIZE") 0.02))
) ;_ and
(progn (grvecs (cons C
(mapcar
(function (lambda (#) (trans (polar P (* # pi) d) 0 1)))
'(0.25 1.25 0.75 1.75)
) ;_ mapcar
) ;_ cons
) ;_ grvecs
P
) ;_ progn
) ;_ if
) ;_ defun



;;; Retrieve closest end point on object
;;; #EntPnt - List with object and point
;;; Alan J. Thompson, 11.10.09
(defun AT:ClosestEndPoint (#EntPnt)
(if (vl-consp #EntPnt)
(car (vl-sort
(list (vlax-curve-getstartpoint (car #EntPnt))
(vlax-curve-getendpoint (car #EntPnt))
) ;_ list
(function
(lambda (a B)
(< (distance (trans (cadr #EntPnt) 1 0) a) (distance (trans (cadr #EntPnt) 1 0) B))
) ;_ lambda
) ;_ function
) ;_ vl-sort
) ;_ car
) ;_ if
) ;_ defun



(setq _angle (lambda (P O / _pt c p2)
(setq _pt (lambda (s)
(vlax-curve-getPointAtDist O (s (vlax-curve-getDistAtPoint O P) 0.00001))
) ;_ lambda
) ;_ setq
(if (and (vl-consp P)
(or (setq p2 (_pt +)) (setq p2 (setq c (_pt -))))
) ;_ and
(if c
(+ pi (angle P p2))
(angle P p2)
) ;_ if
) ;_ if
) ;_ lambda
) ;_ setq


(setq _cmr (lambda (o p2)
(vla-move (setq #TempObj (vla-copy o)) #Pnt (setq #TempPnt (vlax-3D-point p2)))
(setq #List (cons (cons #TempObj #TempPnt) #List))
(and (eq *CAC:Align* "Yes") (vla-rotate #TempObj #TempPnt (_angle p2 #Obj)))
#TempObj
) ;_ lambda
) ;_ setq



(setq _Points (lambda (/ l p)
(if (eq "Points" #Ent)
(if (car (setq l (list (getpoint "\nSpecify first point: "))))
(progn
(while (setq p (getpoint (car l) "\nSpecify next point: "))
(grdraw (car (setq l (cons p l))) (cadr l) 3 -1)
) ;_ while
(and (> (length l) 1) (_PLine l))
) ;_ progn
) ;_ if
T
) ;_ if
) ;_ lambda
) ;_ setq



(setq _PLine (lambda (l / p)
(if (vl-consp l)
(progn
(setq p (entmakex (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(8 . "0")
'(62 . 3)
(cons 90 (length l))
) ;_ list
(mapcar (function (lambda (x) (cons 10 (trans x 1 0)))) l)
) ;_ append
) ;_ entmakex
#Ent (list p (last l))
) ;_ setq
(not (vla-highlight (setq #PLine (vlax-ename->vla-object p)) :vlax-true))
) ;_ progn
) ;_ if
) ;_ lambda
) ;_ setq






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(vl-load-com)

(or *CAC:Option* (setq *CAC:Option* "Divide"))
(or *CAC:Align* (setq *CAC:Align* "No"))

(or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
(vla-startundomark *AcadDoc*)
(redraw)

(initget 0 "Divide dYnamic Measure")
(cond
((and (setq *CAC:Option*
(cond ((getkword
(strcat "\nCopy Along Curve\nSpecify copy option [Divide/dYnamic/Measure] <"
*CAC:Option*
">: "
) ;_ strcat
) ;_ getkword
)
(*CAC:Option*)
) ;_ cond
) ;_ setq
(princ (strcat "\nSelect object(s) to " *CAC:Option* " along curve: "))
(setq #SS (ssget "_:L"))
(setq #Pnt (getpoint "\nSpecify base point: "))
(setq #Ent (AT:Entsel nil
"\nSelect curve or specify points [Points]: "
'((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE"))
"Points"
) ;_ AT:Entsel
) ;_ setq
(_Points)
(vl-consp #Ent)
(setq #Obj (vlax-ename->vla-object (car #Ent)))
) ;_ and
(setq #Len (vlax-curve-GetDistAtParam #Obj (vlax-curve-GetEndParam #Obj))
#Pnt (vlax-3d-point (trans #Pnt 1 0))
#Dist 0.
) ;_ setq
(if (equal (AT:DrawX (AT:ClosestEndPoint #Ent) 1) (vlax-curve-getStartPoint #Obj))
(setq #Val 0.)
(setq #Val #Len)
) ;_ if
(not (initget 0 "Yes No"))
(setq *CAC:Align*
(cond
((getkword (strcat "\nAlign object(s) along curve? [Yes/No] <" *CAC:Align* ">: ")))
(*CAC:Align*)
) ;_ cond
) ;_ setq
(initget 6)
(cond

;; Divide
((and (eq *CAC:Option* "Divide") (setq #Num (getint "\nSpecify number of objects: ")))
(setq #Cnt 0)
(if (or (vl-position (vla-get-objectname #Obj) '("AcDbCircle" "AcDbEllipse"))
(and (eq (vla-get-objectname #Obj) "AcDbPolyline")
(eq (vla-get-closed #Obj) :vlax-true)
) ;_ and
) ;_ or
(setq #Add 0)
(setq #Add 1)
) ;_ if
(while (and (<= #Dist (- #Len (/ #Len (+ #Add #Num)))) (> #Num #Cnt))
(setq #Dist (+ #Dist (/ #Len (+ #Add #Num)))
#Cnt (1+ #Cnt)
) ;_ setq
(vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
(_cmr x (vlax-curve-getpointatdist #Obj #Dist))
) ;_ vlax-for
) ;_ while
)

;; Measure
((and (eq *CAC:Option* "Measure") (setq #Seg (getdist "\nSpecify length of segment: ")))
(while (<= #Dist (- #Len #Seg))
(setq #Dist (+ #Dist #Seg))
(vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
(_cmr x (vlax-curve-getpointatdist #Obj (abs (- #Val #Dist))))
) ;_ vlax-for
) ;_ while
)

;; Dynamic
((and (eq *CAC:Option* "dYnamic") (setq #Seg 0.))
(while (and (numberp #Seg) (<= #Dist #Len))
(princ "\n*")
(initget 6 "Exit X")
(and
(setq #Seg (cond ((getdist (strcat "\nTotal Dist: "
(rtos #Len)
" - Length left: "
(rtos (- #Len #Dist))
"\nDistance to copy [Exit] <"
(rtos #Seg)
">: "
) ;_ strcat
) ;_ getdist
)
(#Seg)
) ;_ cond
) ;_ setq
(numberp #Seg)
(not (zerop #Seg))
(setq #Temp (vlax-curve-getpointatdist #Obj (abs (- #Val (setq #Dist (+ #Dist #Seg))))))
(vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*)) (_cmr x #Temp))
) ;_ and
) ;_ while
)

) ;_ cond

;; additional rotation for objects: 90°, 180°, 270°
(and
#List
(eq *CAC:Align* "Yes")
(while
(and (not (initget "Yes No 1 2 3"))
(setq #Rot (getkword "\nAdditional rotation? 1=90°, 2=180°, 3=270° [1/2/3/No] <No>: "))
(not (eq #Rot "No"))
) ;_ and
(if (cond ((eq #Rot "1") (setq #Ang (* pi 0.5)))
((vl-position #Rot '("2" "Yes")) (setq #Ang pi))
((eq #Rot "3") (setq #Ang (* pi 1.5)))
) ;_ cond
(foreach x #List (vla-rotate (car x) (cdr x) #Ang))
) ;_ if
) ;_ while
) ;_ and

(vl-catch-all-apply 'vla-delete (list #SS))
)
) ;_ cond
(*error* nil)
(princ)
) ;_ defun

  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#24 tpthainguyen

tpthainguyen

    biết zoom

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

Đã gửi 31 May 2011 - 02:12 PM

-Mình đến khóc thét lên chứ không hu hu nổi nửa khi nghe bạn ngồi "xoay từng cái một".
-Nếu với đối tượng lẻ mà nó được thì về nguyên tắc block nó cũng được <_< . Bạn gửi cái file bạn rải cho mình dòm ngó cái block của bạn tí hen!


dạ, mấy đại ca e xoay từng cái một từ lúc biết vẽ cad đến bây giờ ý anh ạ, mà chỉ khoảng mấy trăm cái mỗi lần làm thôi ạ?
  • 0

#25 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 31 May 2011 - 02:28 PM

dạ, mấy đại ca e xoay từng cái một từ lúc biết vẽ cad đến bây giờ ý anh ạ, mà chỉ khoảng mấy trăm cái mỗi lần làm thôi ạ?

Bảo gửi file cho dòm ngó block tí thì không gửi mà giọng văn nghe chừng dỗi rồi :blush:
  • 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


#26 tpthainguyen

tpthainguyen

    biết zoom

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

Đã gửi 31 May 2011 - 02:37 PM

Bảo gửi file cho dòm ngó block tí thì không gửi mà giọng văn nghe chừng dỗi rồi :blush:


Đâu có đâu anh, e đang tìm cách up file lên thôi, tại e chưa up lên bao giờ mà, chứ e có dỗi đâu,

A mà biết ngày xưa mấy anh chị phòng e làm như thế nào thì a còn choáng hơn ý, vì thủ công quá mà, may mà e tìm được forum này nên cũng đã giảm bớt đi nhiều rồi ạ.
http://www.cadviet.c...yen_ninh999.dwg
  • 0

#27 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 31 May 2011 - 02:57 PM

Đâu có đâu anh, e đang tìm cách up file lên thôi, tại e chưa up lên bao giờ mà, chứ e có dỗi đâu,

A mà biết ngày xưa mấy anh chị phòng e làm như thế nào thì a còn choáng hơn ý, vì thủ công quá mà, may mà e tìm được forum này nên cũng đã giảm bớt đi nhiều rồi ạ.
http://www.cadviet.c...yen_ninh999.dwg

http://www.cadviet.com/upfiles/3/tong_xa_yen_ninh999duychinh.dwg

-Đã lưu ý bạn xem lại điểm chèn block rồi mà bạn vẫn để nó ở 1 nơi nào xa lắm í.
-Block trước khi thực hiện lệnh bạn cho góc quay của nó bằng 0 hoặc 90 nhé. (như kiểu bạn ưng thì là 90).
  • 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


#28 tpthainguyen

tpthainguyen

    biết zoom

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

Đã gửi 31 May 2011 - 03:35 PM

dạ, e hiểu rồi ạ, e cảm ơn anh nhiều nhiều ạ!
  • -1

#29 tpthainguyen

tpthainguyen

    biết zoom

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

Đã gửi 01 June 2011 - 08:51 AM

Anh ơi, e chạy đc lệnh dpl rồi ạ, nhưng nó vẫn có một nhược điểm là nếu góc giữa 2 đỉnh là 180 độ thì ko chạy đc đúng ý e muốn, e up cả file lên anh xem giùm e nhé.

http://www.cadviet.c...cat_ne_2005.dwg
  • -1

#30 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 01 June 2011 - 09:06 AM

Anh ơi, e chạy đc lệnh dpl rồi ạ, nhưng nó vẫn có một nhược điểm là nếu góc giữa 2 đỉnh là 180 độ thì ko chạy đc đúng ý e muốn, e up cả file lên anh xem giùm e nhé.

http://www.cadviet.c...cat_ne_2005.dwg

Ờ mình không lường đến trường hợp này để mình nghỉ cách sửa.
  • 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


#31 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 01 June 2011 - 03:23 PM

Anh ơi, e chạy đc lệnh dpl rồi ạ, nhưng nó vẫn có một nhược điểm là nếu góc giữa 2 đỉnh là 180 độ thì ko chạy đc đúng ý e muốn, e up cả file lên anh xem giùm e nhé.

http://www.cadviet.c...cat_ne_2005.dwg

Chỉnh lại lổi nêu trên rồi đây bạn. Tên lệnh như cũ.
;;;;;;;;;;;;;;;;;
(Defun chonnhomdoituong ()
(princ "\nChon doi tuong rai:")
(setq ss (ssget))

(cond
((= ss nil) (princ "\nChua chon duoc doi tuong nao:") (chonnhomdoituong))
((/= ss nil)
(setq dsl (sslength ss))
(cond
((= dsl 1)
(setq doituong (ssname SS 0))
(setq doituong (entget doituong))
(setq KIEUDOITUONG (cdr (assoc 0 doituong)))
(cond
((= KIEUDOITUONG "INSERT") (setq dc (cdr (assoc 10 doituong))))
((/= KIEUDOITUONG "INSERT") (setq dc (getpoint "\nChon diem goc: ")))
);ketthuccondxemblock
);kethucdsl1
((/= dsl 1) (setq dc (getpoint "\nChon diem goc: ")))
);ketthuccondnho

);ketthucsetqdsl
);ketthuccondtong
(princ)
)
;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun C:dpl ( )
(command "undo" "be")
(chonnhomdoituong)

(Prompt "\nChon doi tuong lam duong dan")
(setq doituong1 (entsel))
(while
(null doituong1)
(Prompt "\nChon doi tuong lam duong dan")
(setq doituong1 (entsel))
)

(setq doituongt (car doituong1))
(setq doituong (entget doituongt))

(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)

(setq sodinh (cdr (assoc 90 doituong)))
(setq Rec (acet-geom-vertex-list doituongt))
(setq ttd 1)
(while (< ttd (- sodinh 1))

(setq dinh (nth ttd Rec))
(setq dinhtr (nth (- ttd 1) Rec))
(setq dinhsa (nth (+ ttd 1) Rec))
(setq goctr (angle dinh dinhtr))
(setq gocsa (angle dinh dinhsa))
(setq gockt (angle dinhsa dinhtr))
(setq kiemtra (rtos (- gockt goctr) 2 2))
(cond
((= kiemtra "0.00")
(setq tgtrsa (polar dinh (+ goctr (/ pi 2)) 100))
)
((/= kiemtra "0.00")
(setq tgtr (polar dinh goctr 100))
(setq tgsa (polar dinh gocsa 100))
(setq goctrsa (angle tgtr tgsa))
(setq daitrsa (distance tgtr tgsa))
(setq tgtrsa (polar tgtr goctrsa (/ daitrsa 2)))
)
)


(setq L 0)
(setq M (sslength ss))
(while (< L M)
(setq DT (ssname ss L))
(command ".copy" DT "" dc dinh)
(command ".rotate" "last" "" dinh tgtrsa)
(command ".rotate" "last" "" dinh 90)
(setq L (1+ L))
)

(setq ttd (1+ ttd))
)
(setvar "osmode" luubatdiem)
(command "undo" "end")
(Princ)
)

  • 1

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


#32 tpthainguyen

tpthainguyen

    biết zoom

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

Đã gửi 02 June 2011 - 07:32 AM

Dạ, e thử rồi ạ, chạy tốt quá anh ơi! E cảm ơn anh nhiều lắm ý ạ. Có lips này khối lượng công việc của e chắc chắn sẽ giảm đi rất nhiều ạ!
  • -1

#33 calendar08

calendar08

    biết vẽ arc

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

Đã gửi 02 June 2011 - 08:22 AM

CAD 2012 đã làm được tất cả việc trên. Các bạn ko p đau đầu nữa đâu :D
  • 0

#34 tranhoangxd

tranhoangxd

    biết vẽ circle

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

Đã gửi 02 June 2011 - 08:34 AM

sao em nhìn hình vẽ lệnh này giống lệnh Array thế nhỉ
  • 0

#35 thegiap

thegiap

    biết pan

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

Đã gửi 02 June 2011 - 08:38 AM

Mấy bạn cho mình hỏi,sao mình chọn đường dẫn không được nhỉ,hay là Cad của mình lỗi
  • 0
09 73 46 46 73

#36 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 02 June 2011 - 09:18 AM

Mấy bạn cho mình hỏi,sao mình chọn đường dẫn không được nhỉ,hay là Cad của mình lỗi

Bạn copy đoạn thông báo từ khi chạy đến khi kết thúc từ dòng command lên mình xem thử!
  • 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


#37 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 02 June 2011 - 09:21 AM

CAD 2012 đã làm được tất cả việc trên. Các bạn ko p đau đầu nữa đâu :D

Hi hi ông duy782006 đã nói "(à nghe bảo cad12 đã kết hợp array theo đường dẩn nhưng mình chưa tiếp xúc nên ko biết có bị dẩm lên đó ko nhưng đây là thử nghiệm vì mình tính cho xác định điểm bắt đầu và hướng rải nửa nhưng chưa nghỉ ra kịch bản vì có quá nhiều thường hợp muốn)
"
  • 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


#38 tpthainguyen

tpthainguyen

    biết zoom

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

Đã gửi 02 June 2011 - 09:33 AM

e xem qua giới thiệu của cad 2012 rồi, nhưng nó ko giống như cái e mong muốn, e chỉ cần rải ra đỉnh của pline thôi, dùng lips a Duy viết thì đúng ý em luôn. Mà lại ko fải cài lại cad, hihi
  • -1

#39 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 02 June 2011 - 01:53 PM

e xem qua giới thiệu của cad 2012 rồi, nhưng nó ko giống như cái e mong muốn, e chỉ cần rải ra đỉnh của pline thôi, dùng lips a Duy viết thì đúng ý em luôn. Mà lại ko fải cài lại cad, hihi

Tại topic này vốn là mình khoe cái lisp rải đối tượng thoe đường dẩn nên có các ý kiến trên là đúng rồi. Mình với tpthainguyen phang ngang 1 cái lisp rải đối tượng đến các đỉnh pline vào mà ko báo với khán giả nên các ý kiến nhiều khi không thống nhất quan điểm với nhau.
  • 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


#40 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 June 2011 - 11:09 PM

Theo chương trình hành động nay mình thêm phần chọn điểm bắt đầu rải và hướng rải cho lisp rải đối tượng theo đường dẩn.
*Lệnh rải cho toàn bộ đường dẩn thì vẩn như cũ.
*Lệnh rải từ điểm:
-Tên lệnh RTD.
-Chọn đối tượng cần rải như cũ.
-Chọn đường dẩn như cũ.
-Chọn điểm bắt đầu rải (nằm trên đường dẩn).
-Chọn điểm chỉ hướng rải (nằm trên đường dẩn).
-Lúc này các phần sau giống lisp cũ chỉ có điều đối tượng rải từ điểm bắt đầu do mình chọn và rải về phía mình chọn.
*Dự kiến là sau khi chọn 2 điểm sẽ hỏi các lựa chọn:
-Theo số lượng trên toàn bộ đoạn từ điểm bắt đầu rải theo hướng chỉ và đi hết đường dẩn. (cái này đã có)
-Theo khoảng cách trên toàn bộ đoạn từ điểm bắt đầu rải theo hướng chỉ và đi hết đường dẩn. (cái này đã có)
-Từ điểm bắt đầu rải theo hướng chỉ và đi hết đường dẩn hỏi số lần rải và khoảng cách rải (nhân với nhau không nhất thiết rải đến hết).
-Theo số lượng trên đoạn từ điểm bắt đầu rải đến điểm chỉ hướng.
-Theo khoảng cách trên đoạn từ điểm bắt đầu rải đến điểm chỉ hướng.
Đang nghỉ cách nào gộp vào 1 câu hỏi cho nó ngắn nên tạm thời dùng như trên đã.



(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(hoikieurai)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(chondiemxuatphat)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemxuatphat ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuan (getpoint "\nDiem bat dau rai tren duong dan:"))
(setq diemdinhhuong (getpoint diemchuan"\nHuong rai so voi diem chuan:"))
(setvar "osmode" 0)
(setq daidendiem (vlax-curve-getDistAtPoint chondd diemchuan))
(setq daidenhuong (vlax-curve-getDistAtPoint chondd diemdinhhuong))
(setvar "osmode"luubatdiem)
(Cond
((< daidendiem daidenhuong) (setq chieudaitinh (- chieudaicuver daidendiem)) (setq dautinh +))
((> daidendiem daidenhuong) (setq chieudaitinh daidendiem) (setq dautinh -))
)
(setq doanxuatphat daidendiem)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieuraicd ()
(setq kraicd (strcase (getstring "\nKieu rai theo: So luong/<Khoang cach>")))
(Cond
((= kraicd "S") (raisoluongcd))
((/= kraicd "S")(raikhoangcachcd))
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcachcd ()
(setq chieudaidoan (GETDIST "\nKhoang cach doan chia: "))
(setq sol (+ (/ chieudaitinh chieudaidoan) 1))
(setq sl (fix sol))
(setq sl (fix sl))
(thuchienrai)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongcd ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaitinh slc))
(setq sl (fix (+ 1 slc)))
(thuchienrai)
(princ)
)
;;;;;;;;;;;;;;
(Defun chonnhomdoituong ()
(princ "\nChon doi tuong rai:")
(setq ss (ssget))

(cond
((= ss nil) (princ "\nChua chon duoc doi tuong nao:") (chonnhomdoituong))
((/= ss nil)
(setq dsl (sslength ss))
(cond
((= dsl 1)
(setq doituong (ssname SS 0))
(setq doituong (entget doituong))
(setq KIEUDOITUONG (cdr (assoc 0 doituong)))
(cond
((= KIEUDOITUONG "INSERT") (setq dc (cdr (assoc 10 doituong))))
((/= KIEUDOITUONG "INSERT") (chondiemchuandoituong))
);ketthuccondxemblock
);kethucdsl1
((/= dsl 1) (chondiemchuandoituong))
);ketthuccondnho

);ketthucsetqdsl
);ketthuccondtong
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond
((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
((/= ss nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun choncuver ()

(setq ddd (entsel "\nChon duong dan:"))
(while
(or
(null ddd)
(or (= "TEXT" (cdr (assoc 0 (entget (car ddd))))) (= "MTEXT" (cdr (assoc 0 (entget (car ddd))))) (= "HATCH" (cdr (assoc 0 (entget (car ddd))))) (= "INSERT" (cdr (assoc 0 (entget (car ddd))))) (= "REGION" (cdr (assoc 0 (entget (car ddd))))) (= "DIMENSION" (cdr (assoc 0 (entget (car ddd)))))
)
)
(setq ddd (entsel "\nDoi tuong khong the lam duong dan! Chon lai"))
)

(setq chondd (car ddd))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq chieudaicuver (vlax-curve-getDistAtParam chondd (vlax-curve-getEndParam chondd)))
(setq doanxuatphat 0)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieurai ()
(setq dautinh +)
(setq krai (strcase (getstring "\nKieu rai theo: So luong/<Khoang cach>")))
(Cond
((= krai "S") (raisoluong))
((/= krai "S")(raikhoangcach))
)

(princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcach ()
(setq chieudaidoan (GETDIST "\nKhoang cach doan chia: "))
(setq sol (+ (/ chieudaicuver chieudaidoan) 1))
(setq sl (fix sol))
(setq sl (fix sl))
(thuchienrai)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluong ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaicuver slc))
(setq sl (fix (+ 1 slc)))
(thuchienrai)
(princ)
)
;;;;;;;;;;;;;;
(Defun thuchienrai (/ quaykhong)

(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/<Co>")))
(Cond
((= quaykhong "K") (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiua copyquay))
)

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(setq L 0)
(setq M (sslength ss))
(while (< L M)
(setq DT (ssname ss L))
(command ".copy" DT "" dc p2)
(command ".rotate" "last" "" p2 p5)
(command ".rotate" "last" "" p2 180)
(setq L (1+ L))
)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAY(/ p3)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d3 (+ (dautinh doanxuatphat (* chieudaidoan index)) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquay))
((/= p3 nil)
(setq L 0)
(setq M (sslength ss))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(while (< L M)
(setq DT (ssname ss L))
(command ".copy" DT "" dc p2)
(command ".rotate" "last" "" p2 p3)
(setq L (1+ L))
)
(setvar "osmode"luubatdiem)
)
)


(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYKOQUAY()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" ss "" dc p2 "")
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;

  • 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