Nhờ các bạn giúp đỡ sửa lisp

[Oohlala 2]

(defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	'(100 . "AcDbPolyline")
	(cons 90 (length listpoint))
	(cons 70 (if closed 1 0))))
	(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
	(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
	(entmakex Lst))
;end;=================================
;;;;;;;;;;
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 0) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring 1 (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;============================================================
;========LISP TAO VIEWPORT TREN LAYOUT BANG CACH CHON O MODEL========
;=========================REV4ii=====================================
(defun C:mtll( / os lst khung X_min Y_min X_max Y_max X index taphop pt1)
(vl-load-com)
(if (null (tblsearch "LAYER" "khung")) (_layer2 "Khung" 3))
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (while (/= (setq taphop (ssget "+.:E:S" '((0 . "LWPOLYLINE")))) nil)
  (progn
   (setq tyleVT (getvalue tyleVT 1000.0 "Nhap ty le ban do: "))
  (command "LAYOUT" "S" "Layout1")
  (setq pt1 (getpoint "\nchon diem dat khung"))
  (command "ZOOM" "E")
    (setq khung (ssname taphop 0))
    (setq lst (cdr (acet-geom-vertex-list khung)))
    (setq X_min 1000000000
      Y_min 1000000000
      X_max -1000000000
      Y_max -1000000000)
    (foreach a lst
      (if (< (car a) X_min) (setq X_min (car a)))
      (if (< (cadr a) Y_min) (setq Y_min (cadr a)))
      (if (> (car a) X_max) (setq X_max (car a)))
      (if (> (cadr a) Y_max) (setq Y_max (cadr a)))
      )
    (command "LAYOUT" "S" "Layout1")
    (command "ZOOM" "W" (list X_min Y_min) (list X_max Y_max))
    (makepline lst 1 "Khung" nil nil nil)
    (command "MOVE" (entlast) "" (list X_min Y_min) (list (car pt1) 0))
    (command "ZOOM" "W" (list 0 0) (list (+ (car pt1) 100) 0))
    (command "SCALE" (entlast) "" (list (car pt1) 0) (/ 1000 tyleVT))
    (command "MVIEW" "O" (entlast))
    (command "MSPACE")
    (command "ZOOM" (list X_min Y_min) (list X_max Y_max))
    (command "PSPACE")
	(command "MVIEW" "L" "on" (entlast) "")
    (command "ZOOM" "W" (list 0 0) (list (+ (car pt1) 100) 0))
    (command "MODEL")
    ) ;ene progn while
	) ; end while
  (command "MODEL")
  (command "UNDO" "END")
  (setvar "OSMODE" os)
  (princ)
  )
;======================================================= 

Mình tìm được 1 lsp về tạo viewport từ khung chọn bên model trong topic này http://www.cadviet.com/forum/topic/68723-yeu-cau-lisp-tao-viewport-tu-khung-chon-ben-model/page-6

 

lsp #109 của nhoclangbat rất gần với nhu cầu làm việc của mình, mình muốn nhờ bạn nào biết về lsp sửa giúp cho phù hợp với mình.

 

Mình muốn sửa cách thức nhập tỷ lệ cho viewport khi lsp yêu cầu nhập tỷ lệ ở dòng command ( vd tỷ lệ 1/50 thì nhập là 1/50, tỷ lệ 2/1 thì nhập là 2/1 )

Thứ 2 là tỷ lệ của viewport, ( mình dùng lsp này thấy có vẻ như tác giả scale khung viewport lên n lần theo cái tỷ lệ nhập vào khi lsp yêu cầu ) giờ mình muốn sửa lại là cái viewport đc tạo ra bên layout y nguyên cái khung bên model.

Nhân tiện có cách nào để chỉnh linetype của khung viewport thành nét đứt đc không ?

 

 

[Oohlala 2]

không có bạn nào giúp mình nhỉ :((

[tantran0306 0]

tôi cũng khong biết gì,xlnhé

[snowman.hms 59]

(defun c:m2v (/ #app #doc *error* c cmd lay lst o sc vp)


  (defun *error* (msg)

    (and cmd (setvar 'cmdecho cmd))

    (and #doc (vla-endundomark #doc))

    (if	(and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))

      (princ (strcat "\nError: " msg))

    )

  )


  (setq #app (vlax-get-acad-object)

	#doc (vla-get-activedocument #app)

	cmd (getvar 'cmdecho))


  (if (= 0 (vla-get-activespace #doc)) (vla-put-activespace #doc 1))


  (if (and (princ    "\nSelect a Closed LwPolyline:  ")

	   (setq o   (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (70 . 1))))

	   (setq o   (ssname o 0))

	   (setq c   (pline-centroid o))

	   (setq o   (vlax-ename->vla-object o))

	   (setq sc  (distof (getstring "\nEnter Scale for new Viewport: ")))

	   (setq sc  (/ 1.0 sc))

      )

    (progn

      (vlax-for	lay (vla-get-layouts #doc)

	(if (/= "MODEL" (strcase (vla-get-name lay)))

	  (setq lst (cons (cons (vla-get-name lay) lay) lst))

	)

      )

      (if (setq	lst

		 (mapcar

		   '(lambda (x) (cdr (assoc x lst)))

		   (LM:Listbox

		     "Choose Layout[s] to create ViewPort"

		     (mapcar 'car

			     (vl-sort lst

				      '(lambda (a b)

					 (< (vla-get-taborder (cdr a))

					    (vla-get-taborder (cdr b))

					 )

				       )

			     )

		     )

		     t

		   )

		 )

	  )

	(progn

	  (vla-startundomark #doc)

	  (LM:loadlinetypes '("hidden") nil)

	  (setvar 'cmdecho 0)

	  (foreach lay lst

	    (vla-put-activelayout #doc lay)

	    (setq vp (vlax-vla-object->ename

		       (car (vlax-invoke

			      #doc

			      'copyobjects

			      (list o)

			      (vla-get-block lay)

			    )

		       )

		     )

	    )

	    (vla-put-linetype (vlax-ename->vla-object vp) "hidden")

            (vla-ZoomExtents #app)

	    (vl-cmdf "_.mview" "_object" vp)

	    (setq vp (vlax-ename->vla-object (entlast)))

	    (vla-put-linetype vp "hidden")

	    (vla-display vp :vlax-true)

	    (vla-put-mspace #doc :vlax-true)

	    (vla-put-ActivePViewport #doc vp)

	    (vla-zoomCenter #app (vlax-3d-point c) 1.0)

	    (vla-put-mspace #doc :vlax-false)

	    (vla-put-customscale vp sc)

	    (VLA-ZoomObject vp)

	  )

	)

      )

    )

  )

  (*error* nil)

  (princ)

)


;;==================================================================;;

;;======================== SUB FUNCTION ============================;;

;;==================================================================;;



;;=================== POLYLINE CENTROID BY GILE=====================;;

;; ALGEB-AREA

;; Returns tha algebraic area of the triangle defined by 3  2d points

;; the area is negative if points are clockwise


(defun algeb-area (p1 p2 p3)

  (/ (-	(* (- (car p2) (car p1))

	   (- (cadr p3) (cadr p1))

	)

	(* (- (car p3) (car p1))

	   (- (cadr p2) (cadr p1))

	)

     )

     2.0

  )

)


;; TRIANGLE-CENTROID

;; Returns the centroid of a triangle defined by 3 points


(defun triangle-centroid (p1 p2 p3)

  (mapcar '(lambda (x1 x2 x3)

	     (/ (+ x1 x2 x3) 3.0)

	   )

	  p1

	  p2

	  p3

  )

)


;; POLYARC-CENTROID

;; Returns a list which first item is the centroid of a 'polyarc'

;; and the second its algeraic area

;;

;; Arguments

;; bu : polyarc bulge

;; p1 : start point

;; p2 : end point


(defun polyarc-centroid	(bu p1 p2 / ang rad cen area dist cg)

  (setq	ang  (* 2 (atan bu))

	rad  (/	(distance p1 p2)

		(* 2 (sin ang))

	     )

	cen  (polar p1

		    (+ (angle p1 p2) (- (/ pi 2) ang))

		    rad

	     )

	area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)

	dist (/ (expt (distance p1 p2) 3) (* 12 area))

	cg   (polar cen

		    (- (angle p1 p2) (/ pi 2))

		    dist

	     )

  )

  (list cg area)

)


;; PLINE-CENTROID

;; Returns the WCS coordinates of a lwpolyline centroid

;;

;; Argument

;; pl : the lwpolyline ename


(defun pline-centroid (pl / elst lst tot cen p0 area cen)

  (setq elst (entget pl))

  (while (setq elst (member (assoc 10 elst) elst))

    (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)

	  elst (cdr elst)

    )

  )

  (setq	lst (reverse lst)

	tot 0.0

	cen '(0.0 0.0)

	p0  (caar lst)

  )

  (if (/= 0 (cdar lst))

    (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst))

	  cen (mapcar '(lambda (x) (* x (cadr p-c))) (car p-c))

	  tot (cadr p-c)

    )

  )

  (setq lst (cdr lst))

  (if (equal (car (last lst)) p0 1e-9)

    (setq lst (reverse (cdr (reverse lst))))

  )

  (while (cadr lst)

    (setq area (algeb-area p0 (caar lst) (caadr lst))

	  cen  (mapcar '(lambda (x1 x2) (+ x1 (* x2 area)))

		       cen

		       (triangle-centroid p0 (caar lst) (caadr lst))

	       )

	  tot  (+ area tot)

    )

    (if	(/= 0 (cdar lst))

      (setq p-c	(polyarc-centroid (cdar lst) (caar lst) (caadr lst))

	    cen	(mapcar	'(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))

			cen

			(car p-c)

		)

	    tot	(+ tot (cadr p-c))

      )

    )

    (setq lst (cdr lst))

  )

  (if (/= 0 (cdar lst))

    (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0)

	  cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))

		      cen

		      (car p-c)

	      )

	  tot (+ tot (cadr p-c))

    )

  )

  (trans (list (/ (car cen) tot)

	       (/ (cadr cen) tot)

	       (cdr (assoc 38 (entget pl)))

	 )

	 pl

	 0

  )

)


;;-----------------------=={ List Box }==---------------------;;

;;                                                            ;;

;;  Displays a List Box allowing the user to make a selection ;;

;;  from the supplied data.                                   ;;

;;------------------------------------------------------------;;

;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;

;;------------------------------------------------------------;;

;;  Arguments:                                                ;;

;;  title    - List Box Dialog title                          ;;

;;  lst      - List of Strings to display in the List Box     ;;

;;  multiple - Boolean flag to determine whether the user     ;;

;;             may select multiple items (T=Allow Multiple)   ;;

;;------------------------------------------------------------;;

;;  Returns:  List of selected items, else nil.               ;;

;;------------------------------------------------------------;;


(defun LM:ListBox ( title lst multiple / dch des tmp res )

    (cond

        (   (not

                (and

                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))

                    (setq des (open tmp "w"))

                    (write-line

                        (strcat

                            "listbox : dialog { label = \""

                            title

                            "\"; spacer; : list_box { key = \"list\"; multiple_select = "

                            (if multiple "true" "false")

                            "; } spacer; ok_cancel; }"

                        )

                        des

                    )

                    (not (close des))

                    (< 0 (setq dch (load_dialog tmp)))

                    (new_dialog "listbox" dch)

                )

            )

            (prompt "\nError Loading List Box Dialog.")

        )

        (   t     

            (start_list "list")

            (foreach item lst (add_list item))

            (end_list)

            (setq res (set_tile "list" "0"))

            (action_tile "list" "(setq res $value)")

            (setq res

                (if (= 1 (start_dialog))

                    (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" res ")")))

                )

            )

        )

    )

    (if (< 0 dch)

        (unload_dialog dch)

    )

    (if (and tmp (setq tmp (findfile tmp)))

        (vl-file-delete tmp)

    )

    res

)


;; Load Linetypes  -  Lee Mac

;; Attempts to load a list of linetypes from any .lin files found in the support path.

;; Excludes known metric & imperial definition files based on the value of MEASUREMENT

;; lts - [lst] List of linetypes to load

;; rdf - [bol] If T, linetypes will be redefined from file if already loaded

;; Returns: [bol] T if all linetypes are loaded successfully, else nil


(defun LM:loadlinetypes ( lts rdf / lst ltc rtn val var )

    (if (zerop (getvar 'measurement))

        (setq lst (mapcar 'strcase '("acadiso.lin" "iso.lin")))  ;; Known metric .lin files

        (setq lst (mapcar 'strcase '("acad.lin" "default.lin"))) ;; Known imperial .lin files

    )

    (setq ltc  (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object)))

          var '(cmdecho expert)

          val  (mapcar 'getvar var)

          lst  (vl-remove-if '(lambda ( x ) (member (strcase x) lst))

                   (apply 'append

                       (mapcar '(lambda ( dir ) (vl-directory-files dir "*.lin" 1))

                           (vl-remove "" (LM:str->lst (getenv "ACAD") ";"))

                       )

                   )

               )

    )

    (mapcar 'setvar var '(0 5))

    (setq rtn

        (apply 'and

            (mapcar

               '(lambda ( typ )

                    (cond

                        (   (not (tblsearch "ltype" typ))

                            (vl-some

                               '(lambda ( lin )

                                    (vl-catch-all-apply 'vla-load (list ltc typ lin))

                                    (tblsearch "ltype" typ)

                                )

                                lst

                            )

                        )

                        (   rdf

                            (vl-some

                               '(lambda ( lin )

                                    (and (LM:ltdefined-p typ lin)

                                         (vl-cmdf "_.-linetype" "_L" typ lin "")

                                         (tblsearch "ltype" typ)

                                    )

                                )

                                lst

                            )

                        )

                        (   t   )

                    )

                )

                lts

            )

        )

    )

    (mapcar 'setvar var val)

    rtn

)


;; Linetype Defined-p  -  Lee Mac

;; Returns T if the linetype is defined in the specified .lin file

;; ltp - [str] Linetype name

;; lin - [str] Filename of linetype definition file (.lin)


(defun LM:ltdefined-p ( ltp lin / str rtn )

    (if

        (and

            (setq lin (findfile lin))

            (setq lin (open lin "r"))

        )

        (progn

            (setq ltp (strcat "`*" (strcase ltp) "`,*"))

            (while

                (and (setq str (read-line lin))

                     (not (setq rtn (wcmatch (strcase str) ltp)))

                )

            )

            (close lin)

            rtn

        )

    )

)


;; String to List  -  Lee Mac

;; Separates a string using a given delimiter

;; str - [str] String to process

;; del - [str] Delimiter by which to separate the string

;; Returns: [lst] List of strings


(defun LM:str->lst ( str del / pos )

    (if (setq pos (vl-string-search del str))

        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))

        (list str)

    )

)


(defun VLA-ZoomObject (obj / minPt maxPt)

  (vla-GetBoundingBox obj 'minPt 'maxpt)

  (vla-ZoomWindow (vlax-get-acad-object) minPt maxpt)

)


(vl-load-com)

;|«Visual LISP© Format Options»

(70 2 1 2 nil "_eof " 100 9 0 0 1 T T T T)

;*** DO NOT add text below the comment! ***|;

 

Chỉnh sửa Tháng 6 23, 2015 theo snowman.hms

[Oohlala 2]

(defun c:m2v (/ #app #doc *error* c cmd lay lst o sc vp)

  (defun *error* (msg)
    (and cmd (setvar 'cmdecho cmd))
    (and #doc (vla-endundomark #doc))
    (if	(and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (princ (strcat "\nError: " msg))
    )
  )
  
  (setq #app (vlax-get-acad-object)
	#doc (vla-get-activedocument #app)
	cmd (getvar 'cmdecho))
  
  (if (= 0 (vla-get-activespace #doc)) (vla-put-activespace #doc 1))
  
  (if (and (princ    "\nSelect a Closed LwPolyline:  ")
	   (setq o   (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (70 . 1))))
	   (setq o   (ssname o 0))
	   (setq c   (pline-centroid o))
	   (setq o   (vlax-ename->vla-object o))
	   (setq sc  (distof (getstring "\nEnter Scale for new Viewport: ")))
	   (setq sc  (/ 1.0 sc))
      )
    (progn
      (vlax-for	lay (vla-get-layouts #doc)
	(if (/= "MODEL" (strcase (vla-get-name lay)))
	  (setq lst (cons (cons (vla-get-name lay) lay) lst))
	)
      )
      (if (setq	lst
		 (mapcar
		   '(lambda (x) (cdr (assoc x lst)))
		   (LM:Listbox
		     "Choose Layout[s] to create ViewPort"
		     (mapcar 'car
			     (vl-sort lst
				      '(lambda (a b)
					 (< (vla-get-taborder (cdr a))
					    (vla-get-taborder (cdr b))
					 )
				       )
			     )
		     )
		     t
		   )
		 )
	  )
	(progn
	  (vla-startundomark #doc)
	  (LM:loadlinetypes '("hidden") nil)
	  (setvar 'cmdecho 0)
	  (foreach lay lst
	    (vla-put-activelayout #doc lay)
	    (setq vp (vlax-vla-object->ename
		       (car (vlax-invoke
			      #doc
			      'copyobjects
			      (list o)
			      (vla-get-block lay)
			    )
		       )
		     )
	    )
	    (vla-put-linetype (vlax-ename->vla-object vp) "hidden")
	    (vl-cmdf "_.mview" "_object" vp)
	    (setq vp (vlax-ename->vla-object (entlast)))
	    (vla-put-linetype vp "hidden")
	    (vla-display vp :vlax-true)
	    (vla-put-mspace #doc :vlax-true)
	    (vla-put-ActivePViewport #doc vp)
	    (vla-zoomCenter #app (vlax-3d-point c) 1.0)
	    (vla-put-mspace #doc :vlax-false)
	    (vla-put-customscale vp sc)
	    (VLA-ZoomObject vp)
	  )
	)
      )
    )
  )
  (*error* nil)
  (princ)
)

;;==================================================================;;
;;======================== SUB FUNCTION ============================;;
;;==================================================================;;


;;=================== POLYLINE CENTROID BY GILE=====================;;
;; ALGEB-AREA
;; Returns tha algebraic area of the triangle defined by 3  2d points
;; the area is negative if points are clockwise

(defun algeb-area (p1 p2 p3)
  (/ (-	(* (- (car p2) (car p1))
	   (- (cadr p3) (cadr p1))
	)
	(* (- (car p3) (car p1))
	   (- (cadr p2) (cadr p1))
	)
     )
     2.0
  )
)

;; TRIANGLE-CENTROID
;; Returns the centroid of a triangle defined by 3 points

(defun triangle-centroid (p1 p2 p3)
  (mapcar '(lambda (x1 x2 x3)
	     (/ (+ x1 x2 x3) 3.0)
	   )
	  p1
	  p2
	  p3
  )
)

;; POLYARC-CENTROID
;; Returns a list which first item is the centroid of a 'polyarc'
;; and the second its algeraic area
;;
;; Arguments
;; bu : polyarc bulge
;; p1 : start point
;; p2 : end point

(defun polyarc-centroid	(bu p1 p2 / ang rad cen area dist cg)
  (setq	ang  (* 2 (atan bu))
	rad  (/	(distance p1 p2)
		(* 2 (sin ang))
	     )
	cen  (polar p1
		    (+ (angle p1 p2) (- (/ pi 2) ang))
		    rad
	     )
	area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)
	dist (/ (expt (distance p1 p2) 3) (* 12 area))
	cg   (polar cen
		    (- (angle p1 p2) (/ pi 2))
		    dist
	     )
  )
  (list cg area)
)

;; PLINE-CENTROID
;; Returns the WCS coordinates of a lwpolyline centroid
;;
;; Argument
;; pl : the lwpolyline ename

(defun pline-centroid (pl / elst lst tot cen p0 area cen)
  (setq elst (entget pl))
  (while (setq elst (member (assoc 10 elst) elst))
    (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
	  elst (cdr elst)
    )
  )
  (setq	lst (reverse lst)
	tot 0.0
	cen '(0.0 0.0)
	p0  (caar lst)
  )
  (if (/= 0 (cdar lst))
    (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst))
	  cen (mapcar '(lambda (x) (* x (cadr p-c))) (car p-c))
	  tot (cadr p-c)
    )
  )
  (setq lst (cdr lst))
  (if (equal (car (last lst)) p0 1e-9)
    (setq lst (reverse (cdr (reverse lst))))
  )
  (while (cadr lst)
    (setq area (algeb-area p0 (caar lst) (caadr lst))
	  cen  (mapcar '(lambda (x1 x2) (+ x1 (* x2 area)))
		       cen
		       (triangle-centroid p0 (caar lst) (caadr lst))
	       )
	  tot  (+ area tot)
    )
    (if	(/= 0 (cdar lst))
      (setq p-c	(polyarc-centroid (cdar lst) (caar lst) (caadr lst))
	    cen	(mapcar	'(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
			cen
			(car p-c)
		)
	    tot	(+ tot (cadr p-c))
      )
    )
    (setq lst (cdr lst))
  )
  (if (/= 0 (cdar lst))
    (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0)
	  cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
		      cen
		      (car p-c)
	      )
	  tot (+ tot (cadr p-c))
    )
  )
  (trans (list (/ (car cen) tot)
	       (/ (cadr cen) tot)
	       (cdr (assoc 38 (entget pl)))
	 )
	 pl
	 0
  )
)

;;-----------------------=={ List Box }==---------------------;;
;;                                                            ;;
;;  Displays a List Box allowing the user to make a selection ;;
;;  from the supplied data.                                   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  title    - List Box Dialog title                          ;;
;;  lst      - List of Strings to display in the List Box     ;;
;;  multiple - Boolean flag to determine whether the user     ;;
;;             may select multiple items (T=Allow Multiple)   ;;
;;------------------------------------------------------------;;
;;  Returns:  List of selected items, else nil.               ;;
;;------------------------------------------------------------;;
 
(defun LM:ListBox ( title lst multiple / dch des tmp res )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat
                            "listbox : dialog { label = \""
                            title
                            "\"; spacer; : list_box { key = \"list\"; multiple_select = "
                            (if multiple "true" "false")
                            "; } spacer; ok_cancel; }"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach item lst (add_list item))
            (end_list)
            (setq res (set_tile "list" "0"))
            (action_tile "list" "(setq res $value)")
            (setq res
                (if (= 1 (start_dialog))
                    (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" res ")")))
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    res
)

;; Load Linetypes  -  Lee Mac
;; Attempts to load a list of linetypes from any .lin files found in the support path.
;; Excludes known metric & imperial definition files based on the value of MEASUREMENT
;; lts - [lst] List of linetypes to load
;; rdf - [bol] If T, linetypes will be redefined from file if already loaded
;; Returns: [bol] T if all linetypes are loaded successfully, else nil
 
(defun LM:loadlinetypes ( lts rdf / lst ltc rtn val var )
    (if (zerop (getvar 'measurement))
        (setq lst (mapcar 'strcase '("acadiso.lin" "iso.lin")))  ;; Known metric .lin files
        (setq lst (mapcar 'strcase '("acad.lin" "default.lin"))) ;; Known imperial .lin files
    )
    (setq ltc  (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object)))
          var '(cmdecho expert)
          val  (mapcar 'getvar var)
          lst  (vl-remove-if '(lambda ( x ) (member (strcase x) lst))
                   (apply 'append
                       (mapcar '(lambda ( dir ) (vl-directory-files dir "*.lin" 1))
                           (vl-remove "" (LM:str->lst (getenv "ACAD") ";"))
                       )
                   )
               )
    )
    (mapcar 'setvar var '(0 5))
    (setq rtn
        (apply 'and
            (mapcar
               '(lambda ( typ )
                    (cond
                        (   (not (tblsearch "ltype" typ))
                            (vl-some
                               '(lambda ( lin )
                                    (vl-catch-all-apply 'vla-load (list ltc typ lin))
                                    (tblsearch "ltype" typ)
                                )
                                lst
                            )
                        )
                        (   rdf
                            (vl-some
                               '(lambda ( lin )
                                    (and (LM:ltdefined-p typ lin)
                                         (vl-cmdf "_.-linetype" "_L" typ lin "")
                                         (tblsearch "ltype" typ)
                                    )
                                )
                                lst
                            )
                        )
                        (   t   )
                    )
                )
                lts
            )
        )
    )
    (mapcar 'setvar var val)
    rtn
)
 
;; Linetype Defined-p  -  Lee Mac
;; Returns T if the linetype is defined in the specified .lin file
;; ltp - [str] Linetype name
;; lin - [str] Filename of linetype definition file (.lin)
 
(defun LM:ltdefined-p ( ltp lin / str rtn )
    (if
        (and
            (setq lin (findfile lin))
            (setq lin (open lin "r"))
        )
        (progn
            (setq ltp (strcat "`*" (strcase ltp) "`,*"))
            (while
                (and (setq str (read-line lin))
                     (not (setq rtn (wcmatch (strcase str) ltp)))
                )
            )
            (close lin)
            rtn
        )
    )
)
 
;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings
 
(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

(defun VLA-ZoomObject (obj / minPt maxPt)
  (vla-GetBoundingBox obj 'minPt 'maxpt)
  (vla-ZoomWindow (vlax-get-acad-object) minPt maxpt)
)

(vl-load-com)
;|«Visual LISP© Format Options»
(70 2 1 2 nil "_eof " 100 9 0 0 1 T T T T)
;*** DO NOT add text below the comment! ***|;

bạn ơi cái lsp của bạn mình dùng toàn báo lỗi. khi pick xong polyline, nhập tỷ lệ ( vd 1/100 ) , chọn layout, xong nó tự động chuyển sang layout đã đc chọn, rồi chẳng có gì hiện ra và nó báo lỗi thế này Clip entity not currently regen'ed. ActiveX Server returned the error: unknown name: DisplaySelect object to clip viewport:

[snowman.hms 59]

Um. Mình biết điều này. Mình sẽ kiểm tra lại và cũng hy vọng các bác trên diễn đàn quan tâm chỉ giáo :D

[seovaseo2015 0]

Cái này khá khó, mình đã test nhưng mãi không được

[Oohlala 2]

không ai điều trị ca bệnh này sao :((

[quocmanh04tt 634]

Bạn bỏ dòng này: (command "SCALE" (entlast) "" (list (car pt1) 0) (/ 1000 tyleVT))

Và thêm vào dòng này: (vla-put-customscale (vlax-ename->vla-object (entlast)) tyleVT) ngay sau dòng: (command "PSPACE").

Nhớ thêm (vl-load-com) vào đầu hoặc cuối lisp

[Oohlala 2]

Bạn bỏ dòng này: (command "SCALE" (entlast) "" (list (car pt1) 0) (/ 1000 tyleVT))

Và thêm vào dòng này: (vla-put-customscale (vlax-ename->vla-object (entlast)) tyleVT) ngay sau dòng: (command "PSPACE").

Nhớ thêm (vl-load-com) vào đầu hoặc cuối lisp

Bạn ơi , bạn giúp thì giúp cho trót, bạn sửa giùm luôn file lsp :( mình mù tịt ngôn ngữ lsp. khi dùng lsp này nhập tỷ lệ thì khung viewport bị scale lên n lần. ví dụ mình nhập số 50 thì tỷ lệ viewport đc tạo ra là 20:1

[quocmanh04tt 634]

Như đầu bài của bạn, bạn bảo là 1/50 hay là 1/2 mà!

...

( vd tỷ lệ 1/50 thì nhập là 1/50, tỷ lệ 2/1 thì nhập là 2/1 )

...

[Oohlala 2]

Như đầu bài của bạn, bạn bảo là 1/50 hay là 1/2 mà!

...

( vd tỷ lệ 1/50 thì nhập là 1/50, tỷ lệ 2/1 thì nhập là 2/1 )

...

ý mình là lúc dùng lsp gốc ý, còn bạn bảo cách sửa thêm dòng lệnh vào thì mình sửa thử, cách nhập tỷ lệ thì ok rồi, tuy nhiên nó chưa đúng với ý mình ở cách tạo viewport, ví dụ mình có 1 khung hình chữ nhật để trích xuất 1 chi tiết, mình muốn sau khi dùng lsp thì cái khung đó thành khung viewport luôn với tỷ lệ mình nhập vào, bạn xem bản vẽ ví dụ minh upload để biết.

ngoài ra, lệnh gốc của lsp là mtll sao khi sửa dòng lệnh thì lệnh lsp lại đổi thành Q nhỉ.http://www.cadviet.com/upfiles/5/16559_test.dwg

[quocmanh04tt 634]

1. Có lẽ bạn chưa hiểu về mặt tỷ lệ viewport này.

2. Lisp đã đưa khung hình CN từ model sang layout đúng kích thước (bạn thử đo xem sao).

3. Nếu bạn muốn sang bên layout mà hình vẽ giống như bên model (vị trí, tỷ lệ giữa nội dung trong HCN có nét đứt) thì bạn nhập tỷ lệ bằng 1.

[Oohlala 2]

1. Có lẽ bạn chưa hiểu về mặt tỷ lệ viewport này.

2. Lisp đã đưa khung hình CN từ model sang layout đúng kích thước (bạn thử đo xem sao).

3. Nếu bạn muốn sang bên layout mà hình vẽ giống như bên model (vị trí, tỷ lệ giữa nội dung trong HCN có nét đứt) thì bạn nhập tỷ lệ bằng 1.

đây mình up lại file để giải thích thêm, bạn xem ở bên layout nhé : ( từ trái qua phải )

khung viewport 1 : nhập tỷ lệ là 1 để giống như ý 3 của bạn

khung viewport 2 : nhập tỷ lệ 1/50 nhé và để nguyên mặc định của lsp tạo ra khung đó

khung viewport 3 : cũng là nhập tỷ lệ 1/50 nhưng khung viewport này đc co kéo trùng vào khung hình chữ nhật nét đứt bên model , bạn xem tỷ lệ viewport của khung 2-3 vẫn là như nhau nhé đều 1/50

bạn xem vị trí nội dung hình vẽ so với  hình chữ nhật có nét đứt ở khung viewport 3 ( tl 1/50 ) với khung viewport 1 ( tỷ lệ 1 ) là như nhau 

và ý mình là muốn lsp tạo ra trường hợp viewport 3 chứ không phải như viewport 2http://www.cadviet.com/upfiles/5/16559_test_1.dwg

[quocmanh04tt 634]

Nếu vậy thì quá đơn giản. Do bạn trình bày không rõ ràng.

Để như vậy thì cái này không thể bỏ: ( mình dùng lsp này thấy có vẻ như tác giả scale khung viewport lên n lần theo cái tỷ lệ nhập vào khi lsp yêu cầu )

Bạn làm thế này:

1. Dòng này: (command "SCALE" (entlast) "" (list (car pt1) 0) (/ 1000 tyleVT)). 1000 thay bằng 1

2. Để cho đẹp khi nhập lệnh lần đầu, trong dòng này: (setq tyleVT (getvalue tyleVT 1000 "Nhap ty le ban do: ")), thay 1000 bằng một số khác (ví dụ 50, thì mặc định tỷ lệ 1/50).

3. Để đổi khung thành nét đứt thì thêm dòng này:  (command "_.chprop" (entlast) "" "lt" "HIDDEN" "") ngay sau dòng: (makepline lst 1 "Khung" nil nil nil).

4. Test và cho ý kiến.

[Oohlala 2]

Nếu vậy thì quá đơn giản. Do bạn trình bày không rõ ràng.

Để như vậy thì cái này không thể bỏ: ( mình dùng lsp này thấy có vẻ như tác giả scale khung viewport lên n lần theo cái tỷ lệ nhập vào khi lsp yêu cầu )

Bạn làm thế này:

1. Dòng này: (command "SCALE" (entlast) "" (list (car pt1) 0) (/ 1000 tyleVT)). 1000 thay bằng 1

2. Để cho đẹp khi nhập lệnh lần đầu, trong dòng này: (setq tyleVT (getvalue tyleVT 1000 "Nhap ty le ban do: ")), thay 1000 bằng một số khác (ví dụ 50, thì mặc định tỷ lệ 1/50).

3. Để đổi khung thành nét đứt thì thêm dòng này:  (command "_.chprop" (entlast) "" "lt" "HIDDEN" "") ngay sau dòng: (makepline lst 1 "Khung" nil nil nil).

4. Test và cho ý kiến.

bạn ơi mình sửa theo như bạn chỉ thì cái khung đc tạo giống như mình miểu tả ở post trên rồi nhưng tỷ lệ thì lại ko đc, vd mình nhập tỷ lệ 1/50 thì tỷ lệ khung viewport đc tạo lại là 50:1. bạn xem bản vẽ nhé, khung viewport 4http://www.cadviet.com/upfiles/5/16559_test_2.dwg

[quocmanh04tt 634]

 Vì theo ý bạn ở bài #10, nếu muốn tỷ lệ 1/50 thì nhập 50. Còn nếu muốn nhập 1/50 để có tỷ lệ 1/50 thì tại dòng có: (/ 1000 tyleVT) thay bằng tyleVT [thay cả cụm chính xác như vậy).

[Oohlala 2]

 Vì theo ý bạn ở bài #10, nếu muốn tỷ lệ 1/50 thì nhập 50. Còn nếu muốn nhập 1/50 để có tỷ lệ 1/50 thì tại dòng có: (/ 1000 tyleVT) thay bằng tyleVT [thay cả cụm chính xác như vậy).

 à bạn hiểu nhầm rồi, ở bài #10 là mình đáng nói về cách thức tính tỷ lệ của cái lsp đó.mình vừa sửa theo cách bạn vừa hướng dẫn, tuyệt vời ông mặt giời rồi :D rất cám ơn bạn đã hướng dẫn tận tình 

[quocmanh04tt 634]

 à bạn hiểu nhầm rồi, ở bài #10 là mình đáng nói về cách thức tính tỷ lệ của cái lsp đó.mình vừa sửa theo cách bạn vừa hướng dẫn, tuyệt vời ông mặt giời rồi :D rất cám ơn bạn đã hướng dẫn tận tình 

À ra vậy. Mình mới viết lại, cũng dựa vào thuật toán tương tự của tác giả trên kia nhưng có cải biên ít nhiều. Theo chủ quan thì có vẻ hay hơn.

Đặc điểm:

+ Y/c nhập tỷ lệ thì phải nhập 100 nếu tỷ lệ là 1/100.

+ Nếu bên model đối tượng được chọn là Linetype gì thì sang layout viewport sẽ có Linetype đó (Vì có 1 layer được tạo để chứa tất cả các viewport vừa được tạo ra).

+ Do dùng 1 layer riêng chứa viewport nên tiện cho việc quản lý  bản vẽ.

+ Chủ yếu dùng hàm VL, ít dùng command như lisp cũ.

P/S: Nếu bạn cần thì mình sẽ post lên.

[Oohlala 2]

À ra vậy. Mình mới viết lại, cũng dựa vào thuật toán tương tự của tác giả trên kia nhưng có cải biên ít nhiều. Theo chủ quan thì có vẻ hay hơn.

Đặc điểm:

+ Y/c nhập tỷ lệ thì phải nhập 100 nếu tỷ lệ là 1/100.

+ Nếu bên model đối tượng được chọn là Linetype gì thì sang layout viewport sẽ có Linetype đó (Vì có 1 layer được tạo để chứa tất cả các viewport vừa được tạo ra).

+ Do dùng 1 layer riêng chứa viewport nên tiện cho việc quản lý  bản vẽ.

+ Chủ yếu dùng hàm VL, ít dùng command như lisp cũ.

P/S: Nếu bạn cần thì mình sẽ post lên.

có, bạn up lên đi để tối về mình thử. thức tế cái lsp trên kìa mình sửa theo hướng dẫn của bạn thì phẩn tỷ lệ ngon rồi , duy có phẩn linetype là chưa đc.

[quocmanh04tt 634]

+http://www.cadviet.com/upfiles/5/141736_mtll.zip Nhập n để có tỷ lệ 1/n.

+ Thêm chức năng:

- Tự sinh tỷ lệ trong scale list (VD: nếu bạn nhập 30 thì trong ds sẽ có thêm tỷ lệ 1:30)

- Cho người dùng chọn tên Layout trong listbox.