【源码】多段线对象的剪切变形

(vl-load-com);;;(1)坐标向量的加法(defun vct+(vct1 vct2)  (mapcar '+ vct1 vct2));;;(2)坐标向量的减法(defun vct-(vct1 vct2)  (mapcar '- vct1 vct2));;;(3)向量的内积(defun vct*(vct1 vct2)  (apply'+(mapcar '* vct1 vct2)));;;(4)平面坐标向量的旋转(defun zrot(vct alfa)  (list(vct*(list (cos alfa)(sin (* -1 alfa)))vct)    (vct*(list (sin alfa)(cos alfa))vct)));;;获取多段线点列表(defun plplst( /  pt pplst)  (setq ent(car(entsel"\n请选择要变形多段线:")))  (if ent(progn  (setq plcode(entget ent))  (setq pplst nil)  (repeat (cdr(assoc 90 plcode))    (setq pt (assoc 10 plcode)	  plcode (vl-remove pt plcode)	  pplst(cons pt pplst)))))  (reverse pplst));;;剪切变形函数(defun subshr(pt alfa)  (list(vct*(list 1.0 (/(sin alfa)(cos alfa)))pt)(cadr pt)));;;剪切变换(defun c:shear( / pt0 pt1 alf1 alf2 pplst pplst1 plcode pplst)  (setq pt0 (getpoint "\n 指定不动基点：")	pt1 (getpoint pt0 "\n 指定不变形方向")	alf1 (angle pt0 pt1))  (while(setq pplst(plplst))  (setq pplst1(mapcar'(lambda(x)(zrot(vct-(cdr x)pt0)(* -1 alf1)))pplst))  (setq alf2 (angtof(rtos(getreal"\n 输入变换角度(D):")2 5))	pplst1 (mapcar '(lambda(pt)(cons 10 pt))		       (mapcar '(lambda(pt)(vct+(zrot pt alf1)pt0))			       (mapcar'(lambda(x)(subshr x alf2))pplst1)))) (entmake(append(list'(0 . "LWPOLYLINE")'(100 . "AcDbEntity")		     '(62 . 1)'(100 . "AcDbPolyline")		     (cons 90 (length pplst1))(assoc 70 plcode))		pplst1)))  (princ))