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ị

@Doan Nguyen Van Code em toàn xào nấu từ các đoạn code nhỏ lại với nhau nên rất lủng củng ^^!. Như bác sửa nó chạy qua được viewport không chứa block nhưng viewport chúa block nó lại k BUP đượ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
29 phút trước, naturooo đã nói:

@Doan Nguyen Van Code em toàn xào nấu từ các đoạn code nhỏ lại với nhau nên rất lủng củng ^^!. Như bác sửa nó chạy qua được viewport không chứa block nhưng viewport chúa block nó lại k BUP được ạ :((

Sửa lại cho bạn đây

;;===============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 (and ss1
		 (> (sslength ss1) 0)
	  (setq ss (acet-list-to-ss
		(vl-remove-if-not '(lambda (X) (and (wcmatch (cdr (assoc 0 (entget x))) "INSERT")
						    (wcmatch (strcase (cdr (assoc 2 (entget x))) nil) "DDOC,DDOC1,CD,CD1,CD2,CD3,MC0"))
				     ) (acet-ss-to-list ss1))))
		 )
  	   (progn
    		(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 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 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

 

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

Sửa lại cho bạn đây


;;===============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 (and ss1
		 (> (sslength ss1) 0)
	  (setq ss (acet-list-to-ss
		(vl-remove-if-not '(lambda (X) (and (wcmatch (cdr (assoc 0 (entget x))) "INSERT")
						    (wcmatch (strcase (cdr (assoc 2 (entget x))) nil) "DDOC,DDOC1,CD,CD1,CD2,CD3,MC0"))
				     ) (acet-ss-to-list ss1))))
		 )
  	   (progn
    		(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 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 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

 

Chạy ngon lành rồi ạ. Cảm ơn bác rất nhiều!

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ôi có lisp bo viền 1 khung tên, nhưng mỗi lần chỉ được 1 khung tên

(defun c:ii (/ eName mn mx)
 (vl-load-com)
 (COMMAND "LAYER" "M" "Khung Viewport" "C" "1" "" "L" "CONTINUOUS" "" "LW" "0.13" "" "P" "N" "" "")
 (if (setq eName (car (entsel "\n  >>  Select Object  >> ")))
   (progn
     (vla-getboundingbox (vlax-ename->vla-object eName) 'mn 'mx)
     (vl-cmdf "._rectang" (vlax-safearray->list mn) (vlax-safearray->list mx))))
 (princ))

Nhờ các bác tư vấn hộ có cách nào chọn 1 loạt khung tên để nó bo viền 1 loạt không. Cám ơn rất nhiều.

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

Tôi có lisp bo viền 1 khung tên, nhưng mỗi lần chỉ được 1 khung tên


(defun c:ii (/ eName mn mx)
 (vl-load-com)
 (COMMAND "LAYER" "M" "Khung Viewport" "C" "1" "" "L" "CONTINUOUS" "" "LW" "0.13" "" "P" "N" "" "")
 (if (setq eName (car (entsel "\n  >>  Select Object  >> ")))
   (progn
     (vla-getboundingbox (vlax-ename->vla-object eName) 'mn 'mx)
     (vl-cmdf "._rectang" (vlax-safearray->list mn) (vlax-safearray->list mx))))
 (princ))

Nhờ các bác tư vấn hộ có cách nào chọn 1 loạt khung tên để nó bo viền 1 loạt không. Cám ơn rất nhiều.

Chỉnh lại cho bạn nó hoàn thiện hơn

(defun c:ii (/ lstdt mn mx cur_lay oldos Box)
 (vl-load-com)
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
 (if (not (tblsearch "layer" "Khung Viewport"))
 (COMMAND "LAYER" "M" "Khung Viewport" "C" "1" "" "L" "CONTINUOUS" "" "LW" "0.13" "" "P" "N" "" "")
 )
(setvar "clayer" "Khung Viewport")
(prompt "\nChon doi tuong:")
(setq lstdt (acet-ss-to-list (ssget '((0 . "LWPOLYLINE")))))
(foreach ent lstdt
(vla-getboundingbox (vlax-ename->vla-object ent) 'mn 'mx)
(vl-cmdf "._rectang" (vlax-safearray->list mn) (vlax-safearray->list mx))
(setq Box (vlax-ename->vla-object (entlast)))
(vl-catch-all-apply 'vla-put-ConstantWidth (list Box 0.5))
)
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
 (princ)
)

 

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

Chỉnh lại cho bạn nó hoàn thiện hơn


(defun c:ii (/ lstdt mn mx cur_lay oldos Box)
 (vl-load-com)
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
 (if (not (tblsearch "layer" "Khung Viewport"))
 (COMMAND "LAYER" "M" "Khung Viewport" "C" "1" "" "L" "CONTINUOUS" "" "LW" "0.13" "" "P" "N" "" "")
 )
(setvar "clayer" "Khung Viewport")
(prompt "\nChon doi tuong:")
(setq lstdt (acet-ss-to-list (ssget '((0 . "LWPOLYLINE")))))
(foreach ent lstdt
(vla-getboundingbox (vlax-ename->vla-object ent) 'mn 'mx)
(vl-cmdf "._rectang" (vlax-safearray->list mn) (vlax-safearray->list mx))
(setq Box (vlax-ename->vla-object (entlast)))
(vl-catch-all-apply 'vla-put-ConstantWidth (list Box 0.5))
)
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
 (princ)
)

 

cám ơn bác đã bỏ thời gian. Mục đích của lisp là để bo viền khung tên (hoặc 1 block chữ nhật), sau đó dùng các lisp xuất các rectang đó mỗi một rectang là một layout (hiện giờ các lisp free trên cadviet hay là lisp bán đều chỉ áp dụng được với khung chữ nhật :<)

Do đó bác sửa lisp tuy quét hàng loạt được rồi nhưng lại không chọn được block :(

Nếu được bác sửa lại hộ chọn được cả block thì tốt quá. 

Cám ơn bác trướ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
4 giờ trước, nhimret đã nói:

cám ơn bác đã bỏ thời gian. Mục đích của lisp là để bo viền khung tên (hoặc 1 block chữ nhật), sau đó dùng các lisp xuất các rectang đó mỗi một rectang là một layout (hiện giờ các lisp free trên cadviet hay là lisp bán đều chỉ áp dụng được với khung chữ nhật :<)

Do đó bác sửa lisp tuy quét hàng loạt được rồi nhưng lại không chọn được block :(

Nếu được bác sửa lại hộ chọn được cả block thì tốt quá. 

Cám ơn bác trước.

Sửa lại cho bạn thêm block

(defun c:ii (/ lstdt mn mx cur_lay oldos Box)
 (vl-load-com)
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
 (if (not (tblsearch "layer" "Khung Viewport"))
 (COMMAND "LAYER" "M" "Khung Viewport" "C" "1" "" "L" "CONTINUOUS" "" "LW" "0.13" "" "P" "N" "" "")
 )
(setvar "clayer" "Khung Viewport")
(prompt "\nChon doi tuong:")
(setq lstdt (acet-ss-to-list (ssget '((0 . "LWPOLYLINE,insert")))))
(foreach ent lstdt
(vla-getboundingbox (vlax-ename->vla-object ent) 'mn 'mx)
(vl-cmdf "._rectang" (vlax-safearray->list mn) (vlax-safearray->list mx))
(setq Box (vlax-ename->vla-object (entlast)))
(vl-catch-all-apply 'vla-put-ConstantWidth (list Box 0.5))
)
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
 (princ)
)

 

  • 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
Vào lúc 25/6/2020 tại 21:48, huunhantvxdts đã nói:

Sửa lại cho bạn thêm block


(defun c:ii (/ lstdt mn mx cur_lay oldos Box)
 (vl-load-com)
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
 (if (not (tblsearch "layer" "Khung Viewport"))
 (COMMAND "LAYER" "M" "Khung Viewport" "C" "1" "" "L" "CONTINUOUS" "" "LW" "0.13" "" "P" "N" "" "")
 )
(setvar "clayer" "Khung Viewport")
(prompt "\nChon doi tuong:")
(setq lstdt (acet-ss-to-list (ssget '((0 . "LWPOLYLINE,insert")))))
(foreach ent lstdt
(vla-getboundingbox (vlax-ename->vla-object ent) 'mn 'mx)
(vl-cmdf "._rectang" (vlax-safearray->list mn) (vlax-safearray->list mx))
(setq Box (vlax-ename->vla-object (entlast)))
(vl-catch-all-apply 'vla-put-ConstantWidth (list Box 0.5))
)
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
 (princ)
)

 

cám ơn bác, đã ngon rồi <3

 

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ạn cho mình hỏi có hàm nào đưa Pagesetup ở Layout về <None> (như hình) không ?

Mình có tìm trên mạng thấy lisp này:

(vl-load-com)
(defun c:CPS (/ Adoc Layts clyt)
  (setq	aDoc  (vla-get-activedocument (vlax-get-acad-object))
	Layts (vla-get-layouts aDoc)
	clyt  (vla-get-activelayout aDoc)
  )
  (foreach
	    itm
	       (vl-remove (vla-get-name clyt) (layoutlist))
    (vla-copyfrom (vla-item Layts itm) clyt)
  )
  (princ)
)

Nhưng là copy Pagesetup ở Layout hiện hành ra các Layout khác. Giả sử 1 bản vẽ không có Layout nào có Pagesetup là None thì không dùng đc Lisp này.

Các bạn giúp mình nhé, mình cảm ơn !

Screenshot_1.png

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

@Duong Nhat DuyMình chưa rõ ý của Bạn. Bạn có thể kiểm tra tên pagesetup của layout

;http://theswamp.org/lilly_pond/cab/plotstuff.lsp?nossi=1
; Jason Piercey   Jun 12 2003, 1:39 pm  
; Get current page setup
; [layout] - string, layout name 
; returns current pagesetup of [layout] 
(defun currentPagesetup (layout) 
 (cdr 
  (assoc 
   1 
   (dictsearch 
    (cdar 
     (dictsearch 
      (namedobjdict) 
      "acad_layout" 
      ) 
     ) 
    layout 
    ) 
   ) 
  ) 
 ) 

 

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

@Duong Nhat DuyMình chưa rõ ý của Bạn. Bạn có thể kiểm tra tên pagesetup của layout

  • cadvietlisp.lsp
    lisp help
  •  

;http://theswamp.org/lilly_pond/cab/plotstuff.lsp?nossi=1
; Jason Piercey   Jun 12 2003, 1:39 pm  
; Get current page setup
; [layout] - string, layout name 
; returns current pagesetup of [layout] 
(defun currentPagesetup (layout) 
 (cdr 
  (assoc 
   1 
   (dictsearch 
    (cdar 
     (dictsearch 
      (namedobjdict) 
      "acad_layout" 
      ) 
     ) 
    layout 
    ) 
   ) 
  ) 
 ) 

 

Cái này không phải ý mình, ý mình là 1 hàm đưa cái trong hình về None, vì mình in bằng Pubish 1 lúc nhiều bản vẽ, nhiều Layout, trong đó có nhiều Layout có mấy cái Page setup vớ vẩn như hình (do người khác tạo), đa số thì in ra đều lỗi. Bạn có cách nào ko ?

Screenshot_2.png

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ác nên dùng lisp với lệnh -plot để nó lưu các thông tin trên layout hiện tại in rồi chạy cho các layout khác luôn. Khỏi phải cài đặt cho các layout khác nữa

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

Bác nên dùng lisp với lệnh -plot để nó lưu các thông tin trên layout hiện tại in rồi chạy cho các layout khác luôn. Khỏi phải cài đặt cho các layout khác nữa

Không hiểu ý bạn là gì nhưng mình đã thử lệnh -PLOT, không có thông tin gì liên quan đến Page setup/ Name 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
35 phút trước, Doan Van Ha đã nói:

Vào trang này, dùng hàm addPageSetup

https://jtbworld.com/autocad-pagesetup-lsp

Cảm ơn bạn nhé, nhưng vẫn không phải ý mình :((

Hàm addPageSetup là hàm thêm 1 pagesetup mới.

Hàm sát với ý mình nhất là hàm SetCurrentPageSetup, ví dụ:

(SetCurrentPageSetup (vla-get-activedocument (vlax-get-acad-object)) "Setup2")

Hàm này chuyển Page setup về "Setup2", ý mình muốn chuyển về None, mình đã thử đổi số thành None, "", nil nhưng vẫn ko đ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
40 phút trước, Duong Nhat Duy đã nói:

Cảm ơn bạn nhé, nhưng vẫn không phải ý mình :((

Hàm addPageSetup là hàm thêm 1 pagesetup mới.

Hàm sát với ý mình nhất là hàm SetCurrentPageSetup, ví dụ:

  • cadvietlisp.lsp
    lisp help
  •  

(SetCurrentPageSetup (vla-get-activedocument (vlax-get-acad-object)) "Setup2"

Hàm này chuyển Page setup về "Setup2", ý mình muốn chuyển về None, mình đã thử đổi số thành None, "", nil nhưng vẫn ko đc :((

Bạn dùng hàm này nhé:

Xóa toàn bộ các setup ko muốn ở layout đi ( sau khi xóa setup layout tự mặc định về none)

;;; (deleteAllPageSetupsinlist <AcadDocument> <PageSetupName>)
;;; (deleteAllPageSetupsinlist (vla-get-activedocument (vlax-get-acad-object)) 
	'("In mau 1" "In mau 2"))
(defun deleteAllPageSetupsinlist (doc names)
  (vlax-for pc (vla-get-plotconfigurations doc)
    (if (member (vla-get-name pc) names)
      (vla-delete pc)
    )
  )
)

Có thể dùng hàm này để xóa tất cả setup luôn

;;; (deleteAllPageSetups <AcadDocument>)
;;; (deleteAllPageSetups (vla-get-activedocument (vlax-get-acad-object)))
(defun deleteAllPageSetups (doc)
  (vlax-for pc (vla-get-plotconfigurations doc)
    (vla-delete pc)
  )
)

 

  • 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, Duong Nhat Duy đã nói:

Cảm ơn bạn nhé, nhưng vẫn không phải ý mình :((

Hàm addPageSetup là hàm thêm 1 pagesetup mới.

Hàm sát với ý mình nhất là hàm SetCurrentPageSetup, ví dụ:

  • cadvietlisp.lsp
    lisp help
  •  

(SetCurrentPageSetup (vla-get-activedocument (vlax-get-acad-object)) "Setup2"

Hàm này chuyển Page setup về "Setup2", ý mình muốn chuyển về None, mình đã thử đổi số thành None, "", nil nhưng vẫn ko đc :((

 

Bạn chỉ cần tạo pagesetup trên layout (cài đặt máy in, giấy, ....) sau đó coupyform cho các layout khác thì tất cả là None. Bạn tham khảo code sau

;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/using-and-characters-in-vla-put-canonicalmedianame/td-p/4842089
(defun c:pagesetups()
  (setq	doc	 (vla-get-ActiveDocument (vlax-get-acad-object)))
    (setq plotCfgs (vla-get-ActiveLayout doc))
    (vla-RefreshPlotDeviceInfo plotCfg)
 
    ;; Set the plot device
    (vla-put-ConfigName plotCfg "DWG To PDG.pc3")
    ;; Set the paper size
    (vla-put-CanonicalMediaName plotCfg "ANSI B \(11.00 x 17.00 Inches\)")
    
    (vla-put-PaperUnits plotCfg acMillimeters)

      (setq PLOT_BL (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 1)) '(-53.540381 -6.990000))
        PLOT_TR (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 1)) '(814.00000000 537.00000000))
    )
    (vla-SetWindowToPlot plotCfg PLOT_BL PLOT_TR)
    (vla-put-PlotType plotCfg acWindow)

    (vla-put-UseStandardScale plotCfg :vlax-true)
    (vla-put-StandardScale plotCfg ac1_2)
    (vla-put-CenterPlot plotCfg :vlax-false)
    ;; Hide paperspace objects
    (vla-put-PlotHidden plotCfg :vlax-false)

      ;; Set the plot offset
    (setq origin (vlax-make-safearray vlax-vbDouble '(0 . 1)))
    (vlax-safearray-fill origin (list 0.0 0.0))
    (vla-put-PlotOrigin plotCfg origin)
  
    (vla-put-PlotRotation plotCfg ac90degrees)
    (vla-put-PlotViewportBorders plotCfg :vlax-false)
    (vla-put-PlotViewportsFirst plotCfg :vlax-false)
    (vla-put-PlotWithLineweights plotCfg :vlax-true)
    (vla-put-ScaleLineweights plotCfg :vlax-false)
    (vla-put-PlotWithPlotStyles plotCfg :vlax-true)
    (vla-put-ShowPlotStyles plotCfg :vlax-true)
    (vla-put-StyleSheet plotCfg "MTO_monochrome_Half_Size.ctb")
    (vla-RefreshPlotDeviceInfo plotCfg)

  ;http://forums.augi.com/showthread.php?44555-Apply-page-setup-to-multiple-layouts
(vlax-map-collection
	(vla-get-layouts doc)
	'(lambda (x)
	   (if (eq (vla-get-modeltype x) :vlax-false)
	     (vl-catch-all-error-p (vl-catch-all-apply 'vla-copyfrom (list x plotCfgs)))
	   )
	 )
      )
    (princ)
)

 

  • 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
3 giờ trước, Duong Nhat Duy đã nói:

Không hiểu ý bạn là gì nhưng mình đã thử lệnh -PLOT, không có thông tin gì liên quan đến Page setup/ Name cả.

Kiểu như thế này đây bác.

  • 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
3 giờ trước, Biet ve CAD đã nói:

Bạn dùng hàm này nhé:

Xóa toàn bộ các setup ko muốn ở layout đi ( sau khi xóa setup layout tự mặc định về none)

  • cadvietlisp.lsp
    lisp help
  •  

;;; (deleteAllPageSetupsinlist <AcadDocument> <PageSetupName>)
;; (deleteAllPageSetupsinlist (vla-get-activedocument (vlax-get-acad-object)) 
	'("In mau 1" "In mau 2"))
(defun deleteAllPageSetupsinlist (doc names)
  (vlax-for pc (vla-get-plotconfigurations doc)
    (if (member (vla-get-name pc) names)
      (vla-delete pc)
    )
  )
)

Có thể dùng hàm này để xóa tất cả setup luôn

  • cadvietlisp.lsp
    lisp help
  •  

;;; (deleteAllPageSetups <AcadDocument>)
;; (deleteAllPageSetups (vla-get-activedocument (vlax-get-acad-object)))
(defun deleteAllPageSetups (doc)
  (vlax-for pc (vla-get-plotconfigurations doc)
    (vla-delete pc)
  )
)

 

Mình đã thử cách này, hơi nửa vời, vẫn lỗi khi Publish

Screenshot_1.png

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

 

Bạn chỉ cần tạo pagesetup trên layout (cài đặt máy in, giấy, ....) sau đó coupyform cho các layout khác thì tất cả là None. Bạn tham khảo code sau

  • pagesetups.lsp
    lisp help
  •  

;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/using-and-characters-in-vla-put-canonicalmedianame/td-p/4842089
(defun c:pagesetups()
  (setq	doc	 (vla-get-ActiveDocument (vlax-get-acad-object)))
    (setq plotCfgs (vla-get-ActiveLayout doc))
    (vla-RefreshPlotDeviceInfo plotCfg)
 
    ;; Set the plot device
    (vla-put-ConfigName plotCfg "DWG To PDG.pc3")
    ;; Set the paper size
    (vla-put-CanonicalMediaName plotCfg "ANSI B \(11.00 x 17.00 Inches\)")
    
    (vla-put-PaperUnits plotCfg acMillimeters)

      (setq PLOT_BL (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 1)) '(-53.540381 -6.990000))
        PLOT_TR (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 1)) '(814.00000000 537.00000000))
    )
    (vla-SetWindowToPlot plotCfg PLOT_BL PLOT_TR)
    (vla-put-PlotType plotCfg acWindow)

    (vla-put-UseStandardScale plotCfg :vlax-true)
    (vla-put-StandardScale plotCfg ac1_2)
    (vla-put-CenterPlot plotCfg :vlax-false)
    ;; Hide paperspace objects
    (vla-put-PlotHidden plotCfg :vlax-false)

      ;; Set the plot offset
    (setq origin (vlax-make-safearray vlax-vbDouble '(0 . 1)))
    (vlax-safearray-fill origin (list 0.0 0.0))
    (vla-put-PlotOrigin plotCfg origin)
  
    (vla-put-PlotRotation plotCfg ac90degrees)
    (vla-put-PlotViewportBorders plotCfg :vlax-false)
    (vla-put-PlotViewportsFirst plotCfg :vlax-false)
    (vla-put-PlotWithLineweights plotCfg :vlax-true)
    (vla-put-ScaleLineweights plotCfg :vlax-false)
    (vla-put-PlotWithPlotStyles plotCfg :vlax-true)
    (vla-put-ShowPlotStyles plotCfg :vlax-true)
    (vla-put-StyleSheet plotCfg "MTO_monochrome_Half_Size.ctb")
    (vla-RefreshPlotDeviceInfo plotCfg)

  ;http://forums.augi.com/showthread.php?44555-Apply-page-setup-to-multiple-layouts
(vlax-map-collection
	(vla-get-layouts doc)
	'(lambda (x)
	   (if (eq (vla-get-modeltype x) :vlax-false)
	     (vl-catch-all-error-p (vl-catch-all-apply 'vla-copyfrom (list x plotCfgs)))
	   )
	 )
      )
    (princ)
)

 

Oh hay quá, vậy nghĩa là chỉ cần modify vài thứ cho khác Pagesetup hiện tại là nó tự chuyển về None luôn nhỉ, cảm ơn bạn nhé :))

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
Vừa xong, Biet ve CAD đã nói:

Của bạn vẫn còn setup name tên là 2 kìa, bạn dùng hàm xóa hết các setup đi là tất cả về none

Đúng r bạn ơi, sau khi xóa bằng lệnh đó nó vẫn như thế ấy, mà thôi mình có câu trả lời r, cảm ơn các bạn nhé.

Cảm ơn @narutoo nhé, bạn đi hơi xa quá, mình chỉ cần tên hàm thôi bạn nhé.

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

Tại thấy bác dùng Publish thì hơi bất tiện 1 layout được 1 bản vẽ thì phải :D

Đúng r bạn, nhưng chỉ cần làm chuẩn chỉ thì Publish vẫn ngon, mình thấy đây là cách đơn giản nhất r, quan trọng là ko cần thêm bất cứ file gì đi kèm (ví dụ file lisp, file sheetset)

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 e hỏi file lisp có các vòng lặp gì mà dòng nhắc lệnh cứ báo là: 

 

Command: a22
Select objects: Specify opposite corner: 3 found

Select objects:  Unknown command "A22".  Press F1 for help.
Unknown command "A22".  Press F1 for help.
Unknown command "A22".  Press F1 for help.
Unknown command "A22".  Press F1 for help.
Unknown command "A22".  Press F1 for help.

 

 

Xin 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

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

×