Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
tienhuy93

Lisp chuyển từ Spline sang 3DPolyline

Bởi tienhuy93 , trong AutoLisp

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

Doan Van Ha    3.201

Doan Van Ha
Đã đăng
12 giờ trước, tienhuy93 đã nói:

Em không có precison để chọn bác ơi

 

Cad đời thấp (VD 2007) không có tùy chọn convert to Polyline.

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

Bee    154

Bee
Đã đăng
Vào lúc 3/9/2020 tại 15:42, tienhuy93 đã nói:

Nhờ các bác cho em xin lisp chuyển từ SPLINE thành 3DPolyline với ạ . Em cảm ơn

SPL to 3Dpolyline.dwg

Hỏi a GG là ra tương đối nhiều. Đây là 1 ví dụ :D 

;;CADALYST 12/03 AutoLISP Solutions  SPLINE-TO-PLINE.LSP
;;(c) 2003 Tony Hotchkiss

(defun spline-to-pline (/ i)
  (vl-load-com)
  (setq	*thisdrawing* (vla-get-activedocument
			(vlax-get-acad-object)
		      ) ;_ end of vla-get-activedocument
	*modelspace*  (vla-get-ModelSpace *thisdrawing*)
  ) ;_ end of setq
  (setq spline-list (get-spline))
  (setq i (- 1))
  (if spline-list
    (progn
      (setq msg "\nNumber of segments <100>: ")
      (initget 6)
      (setq num (getint msg))
      (if (or (= num 100) (= num nil))
	(setq num 100)
      ) ;_ end of if
      (repeat (length spline-list)
	(setq splobj (nth (setq i (1+ i)) spline-list))
	(convert-spline splobj num)
      ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of spline-to-pline

(defun get-spline (/ spl-list obj spline no-ent i)
  (setq	spl-list nil
	obj	 nil
	spline	 "AcDbSpline"
	selsets	 (vla-get-selectionsets *thisdrawing*)
	ss1	 (vlax-make-variant "ss1")
  ) ;_ end of setq
  (if (= (vla-get-count selsets) 0)
    (setq ssobj (vla-add selsets ss1))
  ) ;_ end of if
  (vla-clear ssobj)
  (setq no-ent 1)
  (while no-ent
    (prompt "\nSelect splines: ")
    (vla-Selectonscreen ssobj)
    (if	(> (vla-get-count ssobj) 0)
      (progn
	(setq no-ent nil)
	(setq i (- 1))
	(repeat	(vla-get-count ssobj)
	  (setq
	    obj	(vla-item ssobj
			  (vlax-make-variant (setq i (1+ i)))
		) ;_ end of vla-item
	  ) ;_ end of setq
	  (cond
	    ((= (vlax-get-property obj "ObjectName") spline)
	     (setq spl-list
		    (append spl-list (list obj))
	     ) ;_ end of setq
	    )
	  ) ;_ end-of cond
	) ;_ end of repeat
      ) ;_ end of progn
      (prompt "\nNo entities selected, try again.")
    ) ;_ end of if
    (if	(and (= nil no-ent) (= nil spl-list))
      (progn
	(setq no-ent 1)
	(prompt "\nNo splines selected.")
	(quit)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of while  
  (vla-delete (vla-item selsets 0))
  spl-list
) ;_ end of get-spline

(defun convert-spline (splobj n / i)
  (setq	point-list   nil
	2Dpoint-list nil
	z-list	     nil
	spl-lyr	     (vlax-get-property splobj 'Layer)
	startSpline  (vlax-curve-getStartParam splobj)
	endSpline    (vlax-curve-getEndParam splobj)
	i	     (- 1)
  ) ;_ end of setq
  (repeat (+ n 1)
    (setq i (1+ i))
    (setq p (vlax-curve-getPointAtParam
	      splobj
	      (* i
		 (/ (- endspline startspline) n)
	      ) ;_ end of *
	    ) ;_ end of vlax-curve-getPointAtParam
    ) ;_ end of setq
    (setq 2Dp	       (list (car p) (cadr p))
	  2Dpoint-list (append 2Dpoint-list 2Dp)
	  point-list   (append point-list p)
	  z	       (caddr p)
	  z-list       (append z-list (list z))
    ) ;_ end of setq
  ) ;_ end of repeat
  (setq summ (apply '+ z-list))
  (setq	arraySpace
	 (vlax-make-safearray
	   vlax-vbdouble ; element type
	   (cons 0
		 (- (length point-list) 1)
	   ) ; array dimension
	 ) ;_ end of vlax-make-safearray
  ) ;_ end of setq
  (setq vert-array (vlax-safearray-fill arraySpace point-list))
  (vlax-make-variant vert-array)
  (if (and (= :vlax-true (vlax-get-property splobj 'IsPLanar))
	   (= summ 0.0)
      ) ;_ end of and
    (setq plobj	(add-polyline
		  2Dpoint-list
		  vla-AddLightweightPolyline
		) ;_ end of add-polyline
    ) ;_ end of setq
    (setq plobj	(add-polyline
		  point-list
		  vla-Add3DPoly
		) ;_ end of add-polyline
    ) ;_ end of setq
  ) ;_ end of if
  (vlax-put-property plobj 'Layer spl-lyr)
  (vla-delete splobj)
  (vlax-release-object splobj)
) ;_ end of convert-spline

(defun add-polyline (pt-list poly-func)
  (setq	arraySpace
	 (vlax-make-safearray
	   vlax-vbdouble
	   (cons 0
		 (- (length pt-list) 1)
	   ) ; array dimension
	 ) ;_ end of vlax-make-safearray
  ) ;_ end of setq
  (setq	vertex-array
	 (vlax-safearray-fill arraySpace pt-list)
  ) ;_ end of setq
  (vlax-make-variant vertex-array)
  (setq	plobj (poly-func
		*modelspace*
		vertex-array
	      ) ;_ end of poly-func
  ) ;_ end of setq
) ;_ end of add-polyline

(defun c:s2p ()
  (spline-to-pline)
  (princ)
) ;_ end of c:s2p

(prompt
  "SPLINE-TO-PLINE by Tony Hotchkiss. Enter S2P to start"
) ;_ end of prompt

 

  • 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

tienhuy93    0

tienhuy93
Đã đăng
Vào lúc 18/9/2020 tại 10:30, Bee đã nói:

Hỏi a GG là ra tương đối nhiều. Đây là 1 ví dụ :D 


;;CADALYST 12/03 AutoLISP Solutions  SPLINE-TO-PLINE.LSP
;(c) 2003 Tony Hotchkiss

(defun spline-to-pline (/ i)
  (vl-load-com)
  (setq	*thisdrawing* (vla-get-activedocument
			(vlax-get-acad-object)
		      ) ;_ end of vla-get-activedocument
	*modelspace*  (vla-get-ModelSpace *thisdrawing*)
  ) ;_ end of setq
  (setq spline-list (get-spline))
  (setq i (- 1))
  (if spline-list
    (progn
      (setq msg "\nNumber of segments <100>: ")
      (initget 6)
      (setq num (getint msg))
      (if (or (= num 100) (= num nil))
	(setq num 100)
      ) ;_ end of if
      (repeat (length spline-list)
	(setq splobj (nth (setq i (1+ i)) spline-list))
	(convert-spline splobj num)
      ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of spline-to-pline

(defun get-spline (/ spl-list obj spline no-ent i)
  (setq	spl-list nil
	obj	 nil
	spline	 "AcDbSpline"
	selsets	 (vla-get-selectionsets *thisdrawing*)
	ss1	 (vlax-make-variant "ss1")
  ) ;_ end of setq
  (if (= (vla-get-count selsets) 0)
    (setq ssobj (vla-add selsets ss1))
  ) ;_ end of if
  (vla-clear ssobj)
  (setq no-ent 1)
  (while no-ent
    (prompt "\nSelect splines: ")
    (vla-Selectonscreen ssobj)
    (if	(> (vla-get-count ssobj) 0)
      (progn
	(setq no-ent nil)
	(setq i (- 1))
	(repeat	(vla-get-count ssobj)
	  (setq
	    obj	(vla-item ssobj
			  (vlax-make-variant (setq i (1+ i)))
		) ;_ end of vla-item
	  ) ;_ end of setq
	  (cond
	    ((= (vlax-get-property obj "ObjectName") spline)
	     (setq spl-list
		    (append spl-list (list obj))
	     ) ;_ end of setq
	    )
	  ) ;_ end-of cond
	) ;_ end of repeat
      ) ;_ end of progn
      (prompt "\nNo entities selected, try again.")
    ) ;_ end of if
    (if	(and (= nil no-ent) (= nil spl-list))
      (progn
	(setq no-ent 1)
	(prompt "\nNo splines selected.")
	(quit)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of while  
  (vla-delete (vla-item selsets 0))
  spl-list
) ;_ end of get-spline

(defun convert-spline (splobj n / i)
  (setq	point-list   nil
	2Dpoint-list nil
	z-list	     nil
	spl-lyr	     (vlax-get-property splobj 'Layer)
	startSpline  (vlax-curve-getStartParam splobj)
	endSpline    (vlax-curve-getEndParam splobj)
	i	     (- 1)
  ) ;_ end of setq
  (repeat (+ n 1)
    (setq i (1+ i))
    (setq p (vlax-curve-getPointAtParam
	      splobj
	      (* i
		 (/ (- endspline startspline) n)
	      ) ;_ end of *
	    ) ;_ end of vlax-curve-getPointAtParam
    ) ;_ end of setq
    (setq 2Dp	       (list (car p) (cadr p))
	  2Dpoint-list (append 2Dpoint-list 2Dp)
	  point-list   (append point-list p)
	  z	       (caddr p)
	  z-list       (append z-list (list z))
    ) ;_ end of setq
  ) ;_ end of repeat
  (setq summ (apply '+ z-list))
  (setq	arraySpace
	 (vlax-make-safearray
	   vlax-vbdouble ; element type
	   (cons 0
		 (- (length point-list) 1)
	   ) ; array dimension
	 ) ;_ end of vlax-make-safearray
  ) ;_ end of setq
  (setq vert-array (vlax-safearray-fill arraySpace point-list))
  (vlax-make-variant vert-array)
  (if (and (= :vlax-true (vlax-get-property splobj 'IsPLanar))
	   (= summ 0.0)
      ) ;_ end of and
    (setq plobj	(add-polyline
		  2Dpoint-list
		  vla-AddLightweightPolyline
		) ;_ end of add-polyline
    ) ;_ end of setq
    (setq plobj	(add-polyline
		  point-list
		  vla-Add3DPoly
		) ;_ end of add-polyline
    ) ;_ end of setq
  ) ;_ end of if
  (vlax-put-property plobj 'Layer spl-lyr)
  (vla-delete splobj)
  (vlax-release-object splobj)
) ;_ end of convert-spline

(defun add-polyline (pt-list poly-func)
  (setq	arraySpace
	 (vlax-make-safearray
	   vlax-vbdouble
	   (cons 0
		 (- (length pt-list) 1)
	   ) ; array dimension
	 ) ;_ end of vlax-make-safearray
  ) ;_ end of setq
  (setq	vertex-array
	 (vlax-safearray-fill arraySpace pt-list)
  ) ;_ end of setq
  (vlax-make-variant vertex-array)
  (setq	plobj (poly-func
		*modelspace*
		vertex-array
	      ) ;_ end of poly-func
  ) ;_ end of setq
) ;_ end of add-polyline

(defun c:s2p ()
  (spline-to-pline)
  (princ)
) ;_ end of c:s2p

(prompt
  "SPLINE-TO-PLINE by Tony Hotchkiss. Enter S2P to start"
) ;_ end of prompt

 

Cảm ơn bác nhé, Tiện bác cho em hỏi là có lisp từ 3DPolyline sang Spline mà vẫn giữ nguyên cao độ không ạ

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

Bee    154

Bee
Đã đăng
Vào lúc 21/9/2020 tại 10:08, tienhuy93 đã nói:

Cảm ơn bác nhé, Tiện bác cho em hỏi là có lisp từ 3DPolyline sang Spline mà vẫn giữ nguyên cao độ không ạ

Có hết :D

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
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×