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

hoacomay70

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

  • Số lượng nội dung

    47

  • Đã tham gia

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

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

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

    Trước bác Tot77 có viết cho em một lisp rất hay như sau:

    - chọn một đường pline 1 cho trước

    - chọn 1 đường pline 2 ( hoặc line)vuông góc với pline 1 đó

    - chọn điểm đầu (hoặc cuối) của pline để xác định hướng rải

    - nhâp khoảng cách cần rải và số lượng đường cần rải

    Lisp sẽ rải ra các đường pline vuông góc với pline 1 và cách pline 2 khoảng cách người dùng nhập.

    Trước em dùng lisp này rất tốt nhưng hiện tại em hay phải thao tác với các đường pline 1 rất dài, bản vẽ nặng, công zoom để chọn được

    điểm cuối của pline rất lâu. Em nhờ các bác có thể sửa giúp lisp để không cần phải chọn điểm đầu (hoặc cuối) của pline mà lisp tự động 

    vẽ ra 2 đầu của pline đc không ạ.

    Em xin cảm ơn.

     

    test.lsp

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

    Vào lúc 5/3/2012 tại 14:42, ketxu đã nói: 
    
(defun c:lt(/ lst lt pt curve txtsiz msp i cen r tmp)
(grtext -1 "Free from Cadviet @Ketxu")
(command "undo" "be")
(vl-load-com)
(setq  txtsiz (cond ((zerop (setq tmp (* (getvar "dimtxt")(getvar "dimscale")))) 1)
 	(T tmp))  
 msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) 
(mapcar 'set '(curve pt) (nentselp "\nPick start point:"))
(setq isFirst (< (distance (vlax-curve-getStartPoint curve) pt)(distance (vlax-curve-getEndPoint curve) pt)) i 0
 ln (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve ))
)
(while (and (setq lt (getreal (strcat "\nNhap ly trinh diem thu " (itoa (setq i (1+ i))) " : "))) (< lt ln))
 (entmake
  (list (cons 0 "CIRCLE")
 (cons 10  (setq cen (vlax-curve-getPointAtDist curve (if isFirst lt (- ln lt)))))
 (cons 40 (setq r 0.1)) ;Kich thuoc vong tron
  )
 )
 (vla-addtext msp (strcat (itoa i) " " (rtos lt 2 2)) (vlax-3d-point (mapcar '+ cen (list 0 (* 2 r) 0))) txtsiz)
 (setq lst (cons (cons i lt) lst))
)
(setq  pt (getpoint "\nDiem dat bang thong ke:"))

(foreach e (reverse lst)
(vla-addtext msp (itoa (car e)) (vlax-3d-point pt) txtsiz)
(vla-addtext msp (rtos (cdr e) 2 2) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz )
(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))
)
(command "undo" "en")
)
     

     

    Bác ơi có thể chỉnh sửa giúp em lisp này bằng cách thay circle bằng block ko ạ (block xoay vuông góc với tuyến luôn ạ). Ngoài ra lisp có thể nhận được lý trình và tên block cần chèn từ bảng cel ngoài như mẫu dưới được không ạ. Cảm ơn bác rất nhiều.

    Capture.PNG

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

    49 phút trước, alisp đã nói:

    Lisp này cũng có rồi, bạn chịu khó gg với tựa "lisp rải xoay block theo đường dẫn" .

    Em có tìm được lisp rải theo đường dẫn nhưng không chọn được theo bảng cel cho trước, vì phải insert rất nhiều block với khoảng cách khác nhau nên em cần lắm tính năng này ạ

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

    Khi làm việc em thường phải chèn rất nhiều block kiểu này, nên xin các bác có thể viết giúp em lisp như sau không ạ.

    Em có 1 đường pline có sẵn, và các block cần chèn lên pline này. Lisp cho em 2 lựa chọn:

    - LC1: khi em nhập khoảng cách trên pline và tên block cần chèn, lisp sẽ tự động

    chèn block trên pline theo hướng vuông góc với pline tại khoảng cách em đã nhâp.

    - LC2: lựa chọn nhập khoảng cách và tên block cần chèn theo file excel (như hình dưới ạ)

    Em xin cảm ơn các bác.

    111.jpg

    222.jpg

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

    Em hay phải làm trơn đường pline theo khoảng cách tuyến tính nên cần nhờ các bác giúp đỡ viết lisp như sau

    Em có 2 đường pline cho trước màu xanh da trời và màu xanh lá cây như hình.

    Nhiệm vụ của em là khi có đường pline thứ 3 màu vàng (gần đường màu xanh da trời), em cần vẽ ra đường pline màu đỏ cách đường màu vàng một khoảng KCA bằng với khoảng cách KCA từ đường màu xanh da trời đến đường màu xanh lá cây (khoảng cách này dóng vuông góc từ đỉnh của pline màu vàng vuông góc với pline xanh da trời).

    Em xin cảm ơn

    c45ab106f0330d6d5422.jpg

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

    Mình cũng muốn tạo đường bao nhưng là đường bao trong khoảng giao cắt giữa các Pline để tính khối lượng trên cắt ngang. Giả sử em có rất nhiều các Pline giao cắt nhau, em muốn tạo đường bao khoảng trống giữa các Pline ấy ạ. Có Bác nào cao thủ viết giúp mình lisp này được không ạ. Em xin cảm ơn.

    f3t364.dwg

    • Vote giảm 1

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

    Vào lúc 8/5/2014 tại 17:52, Tot77 đã nói:

    Bạn thử dùng cái này. Nếu chạy 1 lần mà vẫn còn có text bị chạm nhau là do trước đó nó cách xa nhau nên nó không nằm trong tập chọn, nhưng sau khi di chuyển tập chọn nó lại đè lên text bên ngoài. Nếu vậy bạn chạy thêm 1 lần nữa là được.

    Đây là đề tài không đơn giản, tôi phải nhờ vào hàm express, do đó bạn phải cài express mới chạy được.

      

    

 
     
    (defun c:dan (/ )
      (defun tach(l / n l1 l2)
        (setq n 0 l2 nil)
        (repeat (1- (length l))
          (if (not l1) (setq l1 (list (nth n l))))
          (if (< (width (acet-geom-ss-extents (acet-list-to-ss
    (mapcar 'cadr (append l1 (list (nth (setq n (1+ n)) l) )))) nil)) (* kcach (1+ (length l1))))
    (setq l1 (append l1 (list (nth n l))))
    (progn (if (> (length l1) 1) (setq l2 (append l2 (list l1)))) (setq l1 nil))
    )
        )
        (if l1 (setq l2 (append l2 (list l1))))
        l2
      )
      (defun width(l) (distance (car l) (list (caadr l) (cadar l) )))
      (defun doi(b kc)
        (vla-put-TextAlignmentPoint (vlax-ename->vla-object b)
    (vlax-3d-point (polar ll 0 kc))))
     
      (defun getIP(v)
        (vlax-safearray->list (vlax-variant-value
    (vla-get-TextAlignmentPoint (vlax-ename->vla-object v))))
      )
      ;;====================================;;
      
      (vl-load-com)
      (setvar 'dimzin 8)
      
      (setq kcach1 (getreal (strcat "\nNhap khoang cach dan <"
    (if kcach (rtos kcach 2 3) (rtos (setq kcach 1) 2 3)) ">:" )))
      (if kcach1 (setq kcach kcach1))
     
      (prompt "\nChon nhom text can sap xep")
      (setq lt (vl-remove-if-not '(lambda(x) (equal (* 0.5 pi)
        (vla-get-rotation (vlax-ename->vla-object x )) 0.001))
    (acet-ss-to-list (ssget '((0 . "text"))))))
      (acet-tjust (setq ss (acet-list-to-ss lt)) (acet-tjust-keyword (entget (ssname ss 0))))
      
      (setq lt (mapcar '(lambda(x) (list (getIP x) x)) lt)
    lt (vl-sort lt '(lambda (x y) (>= (cadar x) (cadar y))))
      )  
      
      (while lt
        (setq lt1 (vl-sort (vl-remove-if-not '(lambda(x) (equal (cadar x) (cadar (car lt)) kcach)) lt)
      '(lambda (x y) (< (caar x) (caar y))))
     lt  (vl-remove-if '(lambda(x) (equal (cadar x) (cadar (car lt)) kcach)) lt)
     lt1 (tach lt1)
        )
        
        (foreach lv lt1
          (setq slv (mapcar 'cadr lv)
       n0 (fix (* 0.5 (length slv)))
       ll (getIP (nth n0 slv))
                k 0)
          (while (>= (setq n (- n0 (setq k (1+ k)))) 0)
    (doi (nth n slv) (* k (- kcach))))
          (setq k 0)
          (while (< (setq n (+ n0 (setq k (1+ k)))) (length slv))
    (doi (nth n slv) (* k kcach))) 
        )
      )
      (princ)
    )
     

     

    Bác ơi Bác có thể sửa giúp em cho các text nằm ngang hoặc xoay hướng bất kỳ cũng giãn được không đè lên nhau được không ạ? Nếu không dãn được text xoay hướng bất kỹ thì có thể dãn được thêm các text nằm ngang không thì cao độ trên trắc ngang của em có cả text dọc và text ngang. Em xin cảm ơn Bác.

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

    Lisp rất hay nhưng khi sử dụng mỗi lần làm lại em lại phải khai báo lại các thông số. Bác có thể sửa lisp sao cho em chỉ phải chọn cao độ điểm đặt điểm cơ sở và mẫu ghi một lần rồi các lần sau chỉ cần pick vào điểm cần ghi cao độ là tự ghi ra luôn cao độ theo x, y hay khoảng cách chọn được không ạ. Em xin cảm ơn.

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

    Em làm đường hay phải "bo" các diện tích để tính khối lượng. Nếu pick từng cái rất lâu và mất thời gian. Em có thể nhờ mọi người viết dùm lisp bo nhanh các diện tích này như hình dưới đây được không ạ.

    http://www.cadviet.com/upfiles/5/125447_drawing1.dwg

    Em muốn chỉ cần quét chọn tất cả các đối tượng pline trên hình lisp sẽ tự động "bo" hết toàn bộ diện tích nằm trong bị giới hạn bởi các đường pline đó.

    Em xin cảm ơn.

     

    • Vote giảm 2

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

     

    Bạn thử xem nhé!

    (defun C:TTT (   /  LTSPLINE X)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq Olmode (getvar "OSMODE"))
  (setq LtsPline (CV:ss-to-list (ssget (list (cons 0 "*LWPOLYLINE,POLYLINE"))) nil))
  (command "Zoom" "e")
  (mapcar '(lambda(x)(Ttt1 x)) LtsPline)
(setvar "OSMODE" Olmode)
(princ)
)

(defun Ttt1 (ent  / A  CMD ENTTTT HV KC12 LENT LENTL LEPT LINT LSPT P1 P2 PNT_D PNT_T SSET TV)
  (vl-load-com)
  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (command "UNDO" "Begin")
;;;  (while (not ent)
;;;    (setq ent (car (entsel "Select edge line: ")))
;;;    (if	ent
;;;      (progn
;;;	(setq entl (entget ent))
;;;      )
;;;    )
;;;  )
  (if ent
    (progn
      (redraw ent 3)
      (setq a 0)
      (setq HV (LM:ssboundingbox (CV:List-to-ss (list ent))))
      (setq P1 (car HV))
      (setq P2 (cadr HV))
      (setq KC12 (distance P1 P2))
      (setq TV (list (/ (+ (car P1) (car P2)) 2) (/ (+ (cadr P1) (cadr P2)) 2)))
      (setq Pnt_T (list (- (car TV) (/ KC12 2)) (+ (cadr TV) (/ KC12 2))))
      (setq Pnt_D (list (+ (car TV) (/ KC12 2)) (- (cadr TV) (/ KC12 2))))
      (setq sset (ssget "W" Pnt_T Pnt_D (list (cons 0 "LINE"))))
      (if sset
	(repeat	(sslength sset)
	  (setq	lentl (entget (setq lent (ssname sset a)))
		lspt  (cdr (assoc 10 lentl))
		lept  (cdr (assoc 11 lentl))
	  )
	  (setq entttt (ssname sset a))
	  (setq lint (nth 0 (x_intlst ent entttt acExtendOtherEntity)))
	  (if lint
	    (progn

	      (if (< (distance lint lspt) (distance lint lept))
		(entmod	(subst
			  (cons 10 lint)
			  (assoc 10 lentl)
			  lentl
			)
		)
		(entmod	(subst
			  (cons 11 lint)
			  (assoc 11 lentl)
			  lentl
			)
		)
	      )
	    )
	  )
	  (setq a (1+ a))
	)
	
      )
      (redraw ent 4)
    )
  )
  (setvar "CMDECHO" cmd)
  (command "UNDO" "End")
  (princ)
)

;;; by kuangdao at xdcad
(defun x_intlst	(obj1 obj2 param / intlst1 intlst2 ptlst)

  (if (= 'ENAME (type obj1))
    (setq obj1 (vlax-ename->vla-object obj1))
  )
  (if (= 'ENAME (type obj2))
    (setq obj2 (vlax-ename->vla-object obj2))
  )
  (setq
    intlst1 (vlax-variant-value (vla-intersectwith obj1 obj2 param))
  )
  (if (< 0 (vlax-safearray-get-u-bound intlst1 1))
    (progn
      (setq intlst2 (vlax-safearray->list intlst1))
      (while (> (length intlst2) 0)
	(setq ptlst   (cons (list (car intlst2) (cadr intlst2) (caddr intlst2))
			    ptlst
		      )
	      intlst2 (cdddr intlst2)
	)
      )
    )
  )
  ptlst
)

(defun LM:ssboundingbox ( s / a b i m n o )
    (repeat (setq i (sslength s))
        (if
            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
            )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)
            )
        )
    )
    (if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    )
)

(defun CV:List-to-ss (lst / ss)
(setq ss (ssadd))
(foreach item lst
  (or (= (type item ) 'Ename)
   (setq item (vlax-vla-object->ename  item)))
  (setq ss (ssadd item ss))
)
ss
)

(defun CV:ss-to-list (ss vla / n e l)
  (setq n (sslength ss))
  (while (setq e (ssname ss (setq n (1- n))))
	(setq l (cons (if vla (vlax-ename->vla-object e) e) l))
  ) 
)

    Bac oi minh chi duoc quet chon doi tuong mot lan thoi a? Cach dung the nao vay a. Em quet chon thi khong thay gi ca. Bac xem giup em duoc khong. Cam on bac rat nhieu.

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

     

    Vậy bạn thử cái này, chỉ dùng với line thôi, và khi giao điểm của 2 line ở gần, chứ không thể kéo dài tới vô cực được.

     
(defun C:tnn(/ ss n sli vn tm)
  (defun dxf(id v) (cdr (assoc id (entget v))))
  (defun midp(v / d1 d2) (setq d1 (dxf 10 v) d2 (dxf 11 v))
    (polar d1 (angle d1 d2) (* 0.5 (distance d1 d2))))
  
  (defun ints (o1 o2 mo / l0 l)
    (setq l (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo)
l0 nil)
    (while l
      (setq l0 (append l0 (list (list (car l) (cadr l) (caddr l))))
    l (cdddr l)))
    l0
  )
  ;;;
  (setq ss (ssget '((0 . "LINE"))))
  (command "fillet" "r" 0)
  (if (and ss (= (sslength ss) 2))
    (command "fillet"  (list (ssname ss 0) (midp (ssname ss 0)))
    (list (ssname ss 1) (midp (ssname ss 1))))
    (progn
      (setq n -1 sli (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (while (< n (1- (length sli)))
        (setq vn (nth (setq n (1+ n)) sli))
        (foreach v sli
 (setq tm (vlax-curve-getDistAtParam v (vlax-curve-getEndParam v)))
          (if (vl-remove-if-not '(lambda(x) (or (< (distance x (dxf 10 v)) tm)
(< (distance x (dxf 11 v)) tm))) (ints vn v acExtendBoth))
   (command "fillet"  (list v (midp v)) (list vn (midp vn))) ))
        
      )
    )
  )
)
 

    Sao em dùng li sp bao loi ; error: syntax error vay a. Bac sua giup em duoc khong.

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

     

    Của bạn đây.

    (defun c:test(/ cd pl obj dd dait cl sl n os ki )
  (defun ad(v p1 p2 / a1)
    (abs (- (vlax-curve-getDistAtPoint (setq a1 (vlax-ename->vla-object v)) (vlax-curve-getClosestPointTo a1 p2))
  (vlax-curve-getDistAtPoint a1 (vlax-curve-getClosestPointTo a1 p1)))))
  
  (defun getp(v dis)
     (vlax-curve-getPointAtDist (vlax-ename->vla-object v) dis))
  
  (defun thgoc (ent pt / param obj) 
    (if (setq param (vlax-curve-getParamAtPoint (setq obj (vlax-ename->vla-object ent)) pt))
      (- (angle '(0 0 0) (vlax-curve-getFirstDeriv obj param))  (/ pi 2))
      nil))
  
  (defun daitc(v / obj)    
      (vlax-curve-getDistAtParam (setq obj (vlax-ename->vla-object v)) (vlax-curve-getEndParam obj)))
  
  ;;;
  
  (setq pl (car (entsel "\nChon Polyline:"))
li (car (entsel "\nChon duong thang vuong goc voi Polyline:"))
dail (daitc li)
dd (getpoint "\nDiem cuoi cua Polyline:")
cd (getreal "\nNhap buoc de rai:")
obj (vlax-ename->vla-object pl) 
dg (vlax-curve-getClosestPointTo obj (acet-dxf 10 (entget li)))
sl (getint "\nSo luong coc rai")
ct (vlax-curve-getDistAtPoint obj dg)
n 0
os (getvar "OSMODE"))
  (if (< (distance dd (vlax-curve-getStartPoint obj)) (distance dd (vlax-curve-getEndPoint obj)))
    (setq ki nil) (setq ki t))
  (setvar "OSMODE" 0)
  (repeat sl         
    (command "line"
    (setq dg1 (if ki (getp pl (+ ct (* (setq n (1+ n)) cd)))
     (getp pl (- ct (* (setq n (1+ n)) cd)))))   
    (polar dg1 (thgoc pl dg1) dail) ""))
  (setvar "OSMODE" os)
  (princ)
)

    Bác ơi có thể giúp em thêm một chút là không phải chọn điểm đầu hoặc cuối của pline, lisp tu vẽ ra duong vuông goc ve hai phia duoc khong a, em hay lam tren layout, moi lan rai lai phai quay qua model de chon diem dau va diem cuoi kho qua.

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

    Em tìm được trên mạng lisp sau tự động extend và trim các đường Pline

    auto-trim-extend.gif?w=640

    ;;; Touch.LSP *
    ;;; Small routine to align endpoints of lines to an edge. *
    ;;; The edge have to be a line. *
    ;;; The routine works by calculating the point of inter- *
    ;;; section and change the nearest endpoint to that point *
    ;;; 2001 Stig Madsen, no rights reserved *
    ;;; modified by qjchen, the edge line can be line or polyline *
    ;
    ;GREAT for PROJECTING LINES FOR ELEVATIONS !!!!!!!!!!!
    ;
    (defun C:Ttt (/ cmd ent entl spt ept sset a lent lentl lspt lept lint)
    (vl-load-com)
    (setq cmd (getvar "CMDECHO"))
    (setvar "CMDECHO" 0)
    (command "UNDO" "Begin")
    (while (not ent)
    (setq ent (car (entsel "Select edge line: ")))
    (if ent
    (progn
        (setq entl (entget ent))
    )
    )
    )
    (if ent
    (progn
    (redraw ent 3)
    (prompt "\nSelect lines to touch edge: ")
    (setq sset (ssget '((0 . "LINE")))
         a 0
    )
    (if sset
        (repeat (sslength sset)
         (setq lentl (entget (setq lent (ssname sset a)))
            lspt (cdr (assoc 10 lentl))
            lept (cdr (assoc 11 lentl))
         )
         (setq entttt (ssname sset a))
         (setq lint (nth 0 (x_intlst ent entttt acExtendOtherEntity)))
         (if lint
         (progn

         (if (< (distance lint lspt) (distance lint lept))
            (entmod (subst
                 (cons 10 lint)
                 (assoc 10 lentl)
                 lentl
                )
            )
            (entmod (subst
                 (cons 11 lint)
                 (assoc 11 lentl)
                 lentl
                )
            )
         )
         )
         )
         (setq a (1+ a))
        )
        (princ "\nNo objects found")
    )
    (redraw ent 4)
    )
    (princ "\nNo edge selected")
    )
    (setvar "CMDECHO" cmd)
    (command "UNDO" "End")
    (princ)
    )

    ;;; by kuangdao at xdcad
    (defun x_intlst (obj1 obj2 param / intlst1 intlst2 ptlst)

    (if (= 'ENAME (type obj1))
    (setq obj1 (vlax-ename->vla-object obj1))
    )
    (if (= 'ENAME (type obj2))
    (setq obj2 (vlax-ename->vla-object obj2))
    )
    (setq intlst1 (vlax-variant-value (vla-intersectwith obj1 obj2 param)))
    (if (< 0 (vlax-safearray-get-u-bound intlst1 1))
    (progn
    (setq intlst2 (vlax-safearray->list intlst1))
    (while (> (length intlst2) 0)
        (setq ptlst (cons (list (car intlst2) (cadr intlst2) (caddr intlst2))
                 ptlst
             )
         intlst2 (cdddr intlst2)
        )
    )
    )
    )
    ptlst
    )

     

    Tuy nhiên như trên lisp chỉ chọn được 1 đường Pline màu xanh, sau đó còn quét chọn tất cả các đường khác lại là đường Line. Em muốn nhờ sửa để lisp có thể chọn được nhiều đường Pline, sau đó quét chọn những đường còn lại cũng là đường Pline để tự động  extend và trim như hình dưới đây. 

    125447_maumau_1.png

    Lisp sẽ yêu cầu chọn các đường Pline cho trước màu xanh, sau đó quét hết các các đường trên bản vẽ, các đường Pline màu đỏ sẽ tự động extend và trim với đường Pline màu xanh gần nó nhất. 

    Em xin cảm ơn.

     

     

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

    Cả nhà cho em hỏi, khi em copy đối tượng từ bản vẽ này sang bản vẽ khác hay dùng lệnh Ctrl+Shift+C và Ctrl+Shift+V, tuy nhiên nhiều lần paste đối tượng ra thì đó là đối tượng của lần copy trước, cứ phải lặp đi lặp lại nhiều lần lệnh thì mới paste ra được đúng đối tượng mình mới copy, rất mất thời gian. Có cách nào để khắc phục lỗi này không ạ?

×