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

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

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

1 giờ trước, naturooo đã nói:

Vẫn vậy bác ạ. Chỉ active viewport được chọn chứ chưa thấy chọn được các đối tượng trong đấy bác ạ!

Bạn gởi bvẽ 2007 lên xem sao?

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

Em xin đoạn code lấy thông số text đưa vào mảng với ạ.

Có: Text1, text2, text3, ...

Cần tạo list: '((text1, x1, y1, z1) (text2, x2, y2, z2) (text3, x3, y3, z3) ....)

với x1 < x2 < x3 < .....

Em cảm ơn ạ!

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
1 giờ} trướ}c, naturooo đã nói:

Em xin đoạn code lấy thông số text đưa vào mảng với ạ.

Có: Text1, text2, text3, ...

Cần tạo list: '((text1, x1, y1, z1) (text2, x2, y2, z2) (text3, x3, y3, z3) ....)

với x1 < x2 < x3 < .....

Em cảm ơn ạ!

Câu hỏi hời hợt quá. Các xi/yi/zi ở đâu ra? Các Text(i) ở đâu ra? Bản vẽ 2007 post lên đi, cái này dễ

  • Like 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
6 phút trước, Doan Van Ha đã nói:

Câu hỏi hời hợt quá. Các xi/yi/zi ở đâu ra? Các Text(i) ở đâu ra? Bản vẽ 2007 post lên đi, cái này dễ

Em gửi bác bản vẽ ví dụ ạ!

vidu.dwg

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


(defun C:HA(/ lst ds td)
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "text")))))))
 (setq lst (mapcar '(lambda(e) (setq ds (entget e) td (cdr (assoc 10 ds))) (list (cdr (assoc 1 ds)) (car td) (cadr td) (caddr td))) lst))
 (vl-sort lst '(lambda(x y) (< (cadr x) (cadr y)))))

  • Like 2

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
1 giờ} trướ}c, Doan Van Ha đã nói:

 


(defun C:HA(/ lst ds td)
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "text")))))))
 (setq lst (mapcar '(lambda(e) (setq ds (entget e) td (cdr (assoc 10 ds))) (list (cdr (assoc 1 ds)) (car td) (cadr td) (caddr td))) lst))
 (vl-sort lst '(lambda(x y) (< (cadr x) (cadr y)))))

 

Quá chuẩn rồi ạ. Em cảm ơn bác!

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

Các bác cho em hỏi đoạn code sau:

(sssetfirst nil (ssget (list (cons 0 "INSERT") (cons 2 "blockname1,blockname2,blockname3"))))

Nếu vùng chọn không có các block có tên trong list trên thì bỏ qua để thực hiện các lệnh tiếp theo thì bổ sung code như thế nào ạ.

Em cảm ơn ạ!

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
19 phút trước, naturooo đã nói:

Các bác cho em hỏi đoạn code sau:

  • cadvietlisp.lsp
    lisp help
  •  

(sssetfirst nil (ssget (list (cons 0 "INSERT") (cons 2 "blockname1,blockname2,blockname3"))))

Nếu vùng chọn không có các block có tên trong list trên thì bỏ qua để thực hiện các lệnh tiếp theo thì bổ sung code như thế nào ạ.

Em cảm ơn ạ!

(if (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "blockname1,blockname2,blockname3"))))
(sssetfirst nil ss)
)

đây bạn

  • Vote tăng 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
1 giờ trước, Biet ve CAD đã nói:
  • cadvietlisp.lsp
    lisp help
  •  

(if (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "blockname1,blockname2,blockname3"))))
(sssetfirst nil ss)
)

đây bạn

Em thêm vào như đoạn code bên dưới nhưng vẫn phải ấn enter nó mới chạy tiếp được anh ạ!

 ......
      (vpsel "W")
      (if (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "DDOC,DDOC1,CD,CD1,CD2,CD3,MC0"))))
      (progn      
      (sssetfirst nil ss)
      (c:BUP)
      )
......

 

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
4 phút trước, naturooo đã nói:

Em thêm vào như đoạn code bên dưới nhưng vẫn phải ấn enter nó mới chạy tiếp được anh ạ!

  • cadvietlisp.lsp
    lisp help
  •  

 ......
      (vpsel "W")
      (if (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "DDOC,DDOC1,CD,CD1,CD2,CD3,MC0"))))
      (progn      
      (sssetfirst nil ss)
      (c:BUP)
      )

 

Do lệnh (C:BUP) của bạn chắc có hàm ssget và chọn luôn cái ss kia nên phải enter

  • Like 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
47 phút trước, Biet ve CAD đã nói:

Do lệnh (C:BUP) của bạn chắc có hàm ssget và chọn luôn cái ss kia nên phải enter

Em muốn nếu k có các block trên thì không thực hiện lệnh BUP thì sửa lại sạo ạ?

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
13 phút trước, naturooo đã nói:

Em muốn nếu k có các block trên thì không thực hiện lệnh BUP thì sửa lại sạo ạ?

(if (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "DDOC,DDOC1,CD,CD1,CD2,CD3,MC0"))))
  (progn
    ;thuc hien khi co block
    (sssetfirst nil ss)
    (c:BUP)
    )
  (progn
    ;thuc hien khi khong co block
    (princ "\nKhong tim thay block")
    )
  )

 

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

Bạn phải xem lại trong lệnh BUP có hàm ssget đó hay không, nếu có thì bỏ ra. Còn không được thì đưa lệnh BUP lên đây

  • Like 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
42 phút trước, Biet ve CAD đã nói:
  • cadvietlisp.lsp
    lisp help
  •  

(if (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "DDOC,DDOC1,CD,CD1,CD2,CD3,MC0"))))
  (progn
    ;thuc hien khi co block
    (sssetfirst nil ss)
    (c:BUP)
    )
  (progn
    ;thuc hien khi khong co block
    (princ "\nKhong tim thay block")
    )
  )

 

Em thử như vậy rồi nó vẫn bắt enter để qua viewport tiếp theo anh ạ!

;;===============UP DIM, UP TEXT, UPBLOCK THEO VIEWPORT=======================================
(defun c:SUP( / oldCmdEcho listVPorts itemVPort ss ssl temp ed old new )
(vl-load-com)
(setq oldCmdEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq currentLayout (getvar "ctab"))
(setvar "CTAB" "Model")
(command "_.ucs" "w");Ve lai Model va dat lai UCS ve World
(foreach lay (layoutlist) (setvar "CTAB" lay)

(if (/= (getvar "CTAB") "Model")
 (progn
  (setq listVPorts (vl-sort (vports) '(lambda(v1 v2) (< (car v1) (car v2)))))
  (if (> (length listVPorts) 1)
   (progn
    (command "_MSPACE")
    (foreach itemVPort (cdr listVPorts)
     (setvar "CVPORT" (car itemVPort))
      (vpsel "W")
      (setq ent (vlax-vla-object->ename
                    (vla-get-activepviewport
                      (vla-get-activedocument (vlax-get-acad-object)))))
      (setq cvscale (vla-get-customscale (vlax-ename->vla-object ent)))
      (setvar "dimscale" (/ 1 cvscale))
      (vpsel "W")
	(if (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "DDOC,DDOC1,CD,CD1,CD2,CD3,MC0"))))
  	   (progn
    	   ;thuc hien khi co block
    		(sssetfirst nil ss)
    		(c:BUP)
           )
  	   (progn
    	   ;thuc hien khi khong co block
    		(princ "\nKhong tim thay block")
    	   )
       );end if
;      (vpsel "C")
;     (getkword "\nPress <ENTER> to go to next viewport")
    )
    (command "_PSPACE")
   )
   (prompt "\nThere are no viewports defined in this Layout!")
  )
 )
 (prompt "\nThis routine works only in Layout!")
)
);END foreach
(setvar "CMDECHO" oldCmdEcho)
(setvar "CTAB" currentLayout)
(princ)
)
;=====================================================================================
;https://lispbox.wordpress.com/2015/05/05/selecting-objects-within-viewport-and-copy-it-to-clipboard-by-selecting-a-ps-viewport/
;;; vpsel.lsp
;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
;;; Website: http://www.jtbworld.com (http://www.jtbworld.com)
;;; E-mail: info@jtbworld.com
;;; 2000-04-14 - First release
;;; Tested on AutoCAD 2000
;;; DESCRIPTION
;;; Select all visible objects in selected or active paperspace viewport Works transparently when in modelspace and for polygonal viewports too
;;; Example1: ERASE ALL R 'VPC >>> Erase all in model except what is visible
;;; Example2: (command "erase" "all" "r" (c:vpc) "")
;;; Example3: VPC ERASE >>> VPC is run previous the command and the objects are also in previous selection set
;;; c:vpc - select all visible objects with crossing in viewport
;;; c:vpw - select all visible objects with window in viewport
;;; Phai dua UCS ve World ******************************************************************************************************************************************
(defun vpsel (typ / ad ss ent vpno ok vpbl vpur msbl msur msul mslr ss1 pl nlist x n)
 (vl-load-com)
 (setq ok t)
 (if (= (getvar "tilemode") 0)
  (progn
   (setq ad (vla-get-activedocument (vlax-get-acad-object)))
   (if (= (getvar "cvport") 1)
    (if (and (= (getvar "cmdactive") 0) (/= (setq ss (ssget ":E:S" '((0 . "VIEWPORT")))) nil))
     (progn
      (setq ent (ssname ss 0))
      (setq vpno (dxf 69 (entget ent)))
      (vla-Display (vla-get-activepviewport ad) :vlax-true)
      (vla-put-mspace ad :vlax-true)
      (setvar "cvport" vpno))
     (progn
      (setq ok nil)
      (princ)))
  (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))))
(if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent))))))
(progn
(if (= (vla-get-clipped (vlax-ename->vla-object ent)) :vlax-false)
(progn
(vla-getboundingbox
(vla-get-activepviewport ad) 'vpbl 'vpur)
(setq msbl (trans (vlax-safearray->list vpbl) 3 2))
(setq msur (trans (vlax-safearray->list vpur) 3 2))
(setq msul (list (car msbl) (cadr msur)))
(setq mslr (list (car msur) (cadr msbl)))
(setq ss1
(ssget (strcat typ "P") (list msbl msul msur mslr))))
(progn
(setq pl (entget (dxf 340 (entget ent))))
(setq nlist nil)
(foreach x pl
(if (eq 10 (car x))
(setq nlist (cons (trans (cdr x) 3 2) nlist))))
(setq ss1 (ssget (strcat typ "P") nlist))))
(sssetfirst nil ss1)
(if ss1
(setq n (sslength ss1))
(setq n 0))
(princ n)
(princ " found ")
(if (and ss1 (= (getvar "cmdactive") 1))
ss1
(princ)))
(princ)))
(princ)))
;=====================================================================================
;--------------------------------------------------------------------------------
(defun DXF (code elist)
  (cdr (assoc code elist))
)
(defun b_ssget ( / ssl  nsset temp ed )
  (setq sset (ssget))
  (setq ssl (sslength sset) 
        nsset (ssadd)
  )
  (print ssl)
  (princ "entities found. ")  
  (princ "\nVerifying the selected entities -- please wait. ")
  (while (> ssl 0)
    (progn
      (setq temp (ssname sset (setq ssl (1- ssl))))
      (setq ed (entget temp))
      (if (= (DXF 0 ed) "INSERT") (ssadd temp nsset))
    )
  )
  (setq ssl (sslength nsset)
        sset nsset
  )
  (print ssl)
  (princ "INSERT entities found. ")
  (princ)
);defun b_ssget
;---------------------------------------------------------------------
(defun c:BUP( / sset ssl temp ed old new )
(setvar "cmdecho" 0)
(setvar "REGENMODE" 0)
  (setq SCALE (getvar "dimscale"))
(b_ssget)
(if (= scale nil) (setq scale (getreal "\nInput current scale: ")))
 
(setq ssl (sslength sset))
  (while (> ssl 0)
    (progn
      (setq temp (ssname sset (setq ssl (1- ssl)))
            ed (entget temp)
            basept (dxf 10 ed)
            oldscale (dxf 41 ed)
            old (cons 41 (DXF 41 ed))
            new (cons 41 scale)
            ed (subst new old ed)

            old (cons 42 (DXF 42 ed))
            new (cons 42 scale)
            ed (subst new old ed)

            old (cons 43 (DXF 43 ed))
            new (cons 43 scale)
            ed (subst new old ed)
      )
      (entmod ed)  
      (setq temp (entnext temp))

      (if (/= temp nil)
         (progn
           (setq ed (entget temp)
                 pt1 (dxf 10 ed)
                 pt2 (dxf 11 ed)
                 old (cons 40 (DXF 40 ed))
                 new (cons 40 (* scale 2))
                 ed (subst new old ed)
                 ratio (/ scale oldscale)
                 pt1 (list (+ (car basept) (* (- (car pt1) (car basept)) ratio))
                           (+ (cadr basept) (* (- (cadr pt1) (cadr basept)) ratio))
                           (+ (caddr basept) (* (- (caddr pt1) (caddr basept)) ratio))
                     )
                 pt2 (list (+ (car basept) (* (- (car pt2) (car basept)) ratio))
                           (+ (cadr basept) (* (- (cadr pt2) (cadr basept)) ratio))
                           (+ (caddr basept) (* (- (caddr pt2) (caddr basept)) ratio))
                     )
                 old (cons 10 (DXF 10 ed))
                 new (cons 10 pt1)
                 ed (subst new old ed)

                 old (cons 11 (DXF 11 ed))
                 new (cons 11 pt2)
                 ed (subst new old ed)
           )
           (entmod ed)  
         )
      )
    )
  )
(command "regen")
 (princ)
);defun

Anh xem lại giúp em ạ!

test.dwg

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
13 phút trước, tien2005 đã nói:

Bạn phải xem lại trong lệnh BUP có hàm ssget đó hay không, nếu có thì bỏ ra. Còn không được thì đưa lệnh BUP lên đây

Em tưởng k có thì nó bỏ qua được chứ nhỉ. Những viewport có thì nó chạy được. Đến viewport không có block thì nó dừng lại bắt enter ạ!

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
17 phút trước, tien2005 đã nói:

Bạn có hàm (b_ssget) trong lệnh BUP

Chỗ này em k hiểu lắm. Như đoạn code của anh Biet Ve CAD thì nó thực hiện khối lệnh thứ 2 của hàm if thì em tưởng nó sẽ bỏ qua hàm BUP chứ ạ?

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

@naturooo khi hàm if thỏa điều kiện [ có (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "DDOC,DDOC1,CD,CD1,CD2,CD3,MC0"))))] thì nó thực hiện khối lệnh 1 là (sssetfirst nil ss) và (c:BUP), nếu không thỏa thì nó thực hiện khối lệnh 2 là (princ "\nKhong tim thay block").

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
8 phút trước, tien2005 đã nói:

@naturooo khi hàm if thỏa điều kiện [ có (setq ss (ssget (list (cons 0 "INSERT") (cons 2 "DDOC,DDOC1,CD,CD1,CD2,CD3,MC0"))))] thì nó thực hiện khối lệnh 1 là (sssetfirst nil ss) và (c:BUP), nếu không thỏa thì nó thực hiện khối lệnh 2 là (princ "\nKhong tim thay block").

Em cũng hiểu như vậy. Vậy khi chạy đến viewport không chưa block mà nó vẫn đòi chọn đối tượng em nghĩ không phải do hàm BUP chứ ạ.

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
32 phút trước, naturooo đã nói:

Em cũng hiểu như vậy. Vậy khi chạy đến viewport không chưa block mà nó vẫn đòi chọn đối tượng em nghĩ không phải do hàm BUP chứ ạ.

Sau 1 hồi bỏng mắt đọc code của bác thì cũng hiểu sơ:

Bác sửa điều kiện (setq ss (ssget thành

(if (and ss1
		 (> (sslength ss1) 0)
	  (setq ss (ssget  (list (cons 0 "INSERT") (cons 2 "DDOC,DDOC1,CD,CD1,CD2,CD3,MC0"))))
		 )
  	   (progn
    		(sssetfirst nil ss)
    		(c:BUP)
           )
  	   (progn
    	   ;thuc hien khi khong co block
    		(princ "\nKhong tim thay block")
    	   )
       )

 

  • Vote tăng 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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×