[原创][LISP]以距离限差、角度限差和步进长度控制的SPLINE2PLINE
本帖最后由 作者 于 2004-2-1 21:06:43 编辑;;;==================================================================
;;;转换SPLINE至PLINE
(DEFUN c:test (/ angle_dlta dist_dlta dist_step num1 ss1)
;;; (SETQ dist_step 1 ;步进距离
;;; dist_dlta 10 ;允许偏离距离
;;; angle_dlta 0.1 ;允许偏离角度,360
;;; )
(SETQ dist_step (GETREAL "步进距离:") ;步进距离
dist_dlta (GETREAL "距离限差:") ;允许偏离距离
angle_dlta (GETREAL "角度限差:") ;允许偏离角度,360
)
(PRINC "\n\t选择SPLINE:")
(spline2pline (SSGET '((0 . "SPLINE"))) dist_step dist_dlta angle_dlta)
(PRINC)
)
;;;转换SPLINE为LWPOLYLINE的折线
;;;ENAME实体名
;;;思路：以SPLINE线上所有连续的两个拟合点为一个单位，进行插入处理。
;;;先以第一个拟合点作为基点，当基点前进若干个步进单位内的点的范围夹角大于偏离角度，
;;;或者范围夹角开口处的距离大于允许偏离距离，则插入一点,
;;;把插入点作为基点再继续，直到基点超过第二个拟合点为止。
;;;新生成LWPOLYLINE线中将保留原来的拟合点。
;;;2/1/04 9:00 下午修改：非三阶拟合线没有拟合点时，只有起点和终点作为拟合点
;;;2/1/04 9:00 下午修改：线方向与原SPLINE方向反了
;;;ss1实体或者选择集
;;;DIST_STEP步进距离
;;;DIST_DLTA允许偏离距离
;;;ANGLE_DLTA允许偏离角度,360
(DEFUN spline2pline (ss1 dist_step
dist_dlta angle_dlta
/ angle_max
angle_min angle_now
angle_tmp curve-obj
data dist_end
dist_start ename
num1 points_new
points_old point_base
point_now
)
(IF (NOT ss1)
(SETQ ss1 (SSADD))
)
(IF (OR (/= 'pickset (TYPE ss1))
(AND (/= 'real (TYPE dist_step)) (/= 'int (TYPE dist_step)))
(AND (/= 'real (TYPE dist_dlta)) (/= 'int (TYPE dist_dlta)))
(AND (/= 'real (TYPE angle_dlta)) (/= 'int (TYPE angle_dlta)))
)
(*error* "参数类型错。")
)
(IF (> (SSLENGTH ss1) 0)
(PRINC (STRCAT "\n\t0\tSPLINE转换为LWPOLYLINE，共< " (ITOA (SSLENGTH ss1)) " >。"))
)
(SETQ angle_dlta (ABS (* (/ (REM angle_dlta 360.0) 180.0) PI))
num1 0
)
(REPEAT (SSLENGTH ss1)
(SETQ ename (SSNAME ss1 num1)
num1 (1+ num1)
data (ENTGET ename)
points_old (IF (ASSOC '11 data)
(MAPCAR 'CDR (VL-REMOVE-IF '(LAMBDA (x) (/= 11 (CAR x))) data))
(LIST (CDR (ASSOC '10 data)) (CDR (ASSOC '10 (REVERSE data))))
)
points_new (LIST (CAR points_old))
points_old (CDR points_old)
curve-obj (VLAX-ENAME->VLA-OBJECT ename)
)
(PRINC (STRCAT "\r\t" (ITOA num1)))
;;对拟合点进行循环
(WHILE points_old
(SETQ dist_start (VLAX-CURVE-GETPARAMATPOINT curve-obj (CAR points_new))
dist_end (VLAX-CURVE-GETPARAMATPOINT curve-obj (CAR points_old))
)
;;步进没到结束下一个拟合点
(WHILE (< (SETQ dist_start (+ dist_start dist_step)) dist_end)
(SETQ point_base (CAR points_new) ;指定方向的第一点
angle_max (ANGLE point_base (VLAX-CURVE-GETPOINTATPARAM curve-obj dist_start))
angle_min angle_max
)
;;步进没有到第一点插入点
(WHILE (AND (< dist_start dist_end) ;没有到下一个拟合点
(SETQ point_now (VLAX-CURVE-GETPOINTATPARAM curve-obj dist_start)
angle_now (ANGLE point_base point_now)
)
(< (SETQ angle_tmp (MAX (ABS (- angle_max angle_now)) (ABS (- angle_min angle_now)))) angle_dlta)
;角度在限差内
(< (* angle_tmp (DISTANCE point_base point_now)) dist_dlta) ;距离在限差内
)
(SETQ dist_start (+ dist_start dist_step))
(IF (> angle_now angle_max)
(SETQ angle_max angle_now)
(IF (< angle_now angle_min)
(SETQ angle_min angle_now)
)
)
)
(IF (< (SETQ angle_tmp (MAX (ABS (- angle_max angle_now)) (ABS (- angle_min angle_now)))) angle_dlta)
(PRINC "\nangle>")
)
(IF (< (* angle_tmp (DISTANCE point_base point_now)) dist_dlta)
(PRINC "\ndist>")
)
(IF (< dist_start dist_end)
(SETQ points_new (CONS point_now points_new))
)
)
(SETQ points_new (CONS (CAR points_old) points_new)
points_old (CDR points_old)
)
)
;;生成多义线
(COMMAND "pline")
(FOREACH x (REVERSE points_new) (COMMAND x))
(IF (= 1 (LOGAND 1 (CDR (ASSOC '70 data))))
(COMMAND "u" "c") ;闭合的
(COMMAND "")
)
;;删除SPLINE
(ENTDEL ename)
)
(PRINC)
)
;;;==================================================================
(PRINC)说明:对于距离限差和角度限差，并不能保证在限差范围之内的最大值，只可以保证在允许限差内。
请大家发表保贵意见。
;;利用OFFSET特性(对SPLINE & ELLIPSEOFFSET后会增加控制点)
;;SPLINE & ELLIPSE TO PLINE
;;BY龙龙仔(LUCAS)
(defun C:S2P (/ HOLDOSMODE HOLDECHO SSS SSL N N1 ENT PT_LIST NUMPT ED PT PT1)
;;T. Tanzillo
(defun VLISP-REMOVE-IF-NOT (KEY LST)
(mapcar 'cdr
(vl-remove-if-not
'(lambda (E) (eq (car E) KEY))
LST
)
)
)
(defun MIDPOINT (PT1 PT2)
(mapcar
'(lambda (X Y)
(* 0.5 (+ X Y))
)
PT1
PT2
)
)
(setq HOLDECHO (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.undo" "group")
(setq HOLDOSMODE (getvar "osmode"))
(setvar "osmode" 0)
(prompt "\n选取SPLINE,ELLIPSE:")
(setq SSS (ssget '((0 . "ELLIPSE,SPLINE"))))
(setq SSL (sslength SSS)
N 0
)
(repeat SSL
(prompt (strcat "\r余 " (itoa (- SSL N)) " 个物件 "))
(setq ENT (vlax-ename->vla-object (ssname SSS N)))
(vl-catch-all-apply
'vla-offset
(list ENT 0.001)
)
(setq ENT (entlast))
(vl-catch-all-apply
'vla-offset
(list (vlax-ename->vla-object ENT) -0.001)
)
(entdel ENT)
(setq ENT (entlast))
(setq PT_LIST (VLISP-REMOVE-IF-NOT 10 (setq ED (entget ENT))))
(setq ENT (vlax-ename->vla-object ENT))
(setq N1 0)
(vl-cmdf "_.pline" (nth N1 PT_LIST) "A")
(if (or (and (= (cdr (assoc 0 ED)) "ELLIPSE")
(= (cdr (assoc 42 ED)) (* pi 2))
)
(and (= (cdr (assoc 0 ED)) "SPLINE")
(= (logand (cdr (assoc 70 ED)) 1) 1)
)
)
(setq NUMPT (- (length PT_LIST) 2))
(setq NUMPT (- (length PT_LIST) 1))
)
(repeat NUMPT
(setq PT (vlax-curve-getclosestpointto
ENT
(MIDPOINT (nth N1 PT_LIST)
(setq PT1 (nth (1+ N1) PT_LIST))
)
)
)
(vl-cmdf "S"
(vlax-curve-getclosestpointto ENT PT)
(vlax-curve-getclosestpointto ENT PT1)
)
(setq N1 (1+ N1))
)
(if (or (and (= (cdr (assoc 0 ED)) "ELLIPSE")
(= (cdr (assoc 42 ED)) (* pi 2))
)
(and (= (cdr (assoc 0 ED)) "SPLINE")
(= (logand (cdr (assoc 70 ED)) 1) 1)
)
)
(vl-cmdf "CL")
(vl-cmdf "")
)
(vla-delete ENT)
(setq N (1+ N))
)
(setvar "osmode" HOLDOSMODE)
(command "_.undo" "end")
(setvar "cmdecho" HOLDECHO)
(princ)
)
虽然offset的距离很小。但从理论上说，是不是还有不可能正确生成单一新实体的缺陷？
页:
[1]