快速绘制指定长度的样条曲线
本帖最后由 dcl1214 于 2023-10-11 11:22 编辑;绘制样条曲线
(vl-doc-export '$c:hzytxrun$)
(defun $c:hzytxrun$ (lst/ $make-spline$
*error*dxf en ents
ent-splinel l-all line-jzx
line-jzx-ent line-jzx-p2
markobj pt pts
pts-sdtmp
)
(defun *error* (s)
(if(and mark (entget mark))
(entdel mark)
)
)
(defun $make-Spline$ (ptn / a)
(entmakex
(append (list '(0 . "SPLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbSpline")
'(71 . 3)
)
(mapcar (function (lambda (pt) (cons 11 pt))) ptn)
)
)
)
(SETQ L-ALL (GETREAL "请输入样条曲线的总长度"))
(if (and L-ALL (> L-ALL 0.5))
(progn
(setq
pt (getpoint
"点击鼠标左键开始绘制样条曲线\n连续敲两次空格结束绘制"
)
)
(if pt
(progn
(setq pts nil)
(setq pts (append pts (list pt)))
(if pt
(progn
(setq
mark (VLAX-VLA-OBJECT->ENAME
(VLA-ADDPOINT
(vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(VLAX-3D-POINT (LIST 0 0 0))
)
)
)
(vl-cmdf "_.spline" "non" pt)
;(setq ent (entlast))
(while (= 1 (logand 1 (getvar 'cmdactive)))
(vl-cmdf "\\")
(setq pts (append pts (list (getvar 'lastpoint))))
(SETQ TMP NIL)
(AND (setq tmp ($make-Spline$ pts))
(SETQ OBJ (VLAX-ENAME->VLA-OBJECT TMP))
(setq
L (vlax-curve-getDistAtPoint
OBJ
(vlax-curve-getEndPoint OBJ)
)
)
)
(and tmp (entget tmp) (entdel tmp))
(IF (>= L L-ALL)
(PROGN
(if(= 1 (logand 1 (getvar 'cmdactive)))
(progn (VL-CMDF "") (VL-CMDF "") (VL-CMDF ""))
)
)
)
(print L)
)
(and ent (setq dxf (entget ent '("*"))))
)
)
(setq en mark)
(setq ents nil)
(while (setq en (entnext en))
(if(and en (entget en))
(setq ents (append ents (list en)))
)
) ;用en循环获取后添加到ents记录里面
(if (and mark (entget mark))
(entdel mark)
)
(setq en nil)
(setq ent-spline (car ents))
(if (and ent-spline (entget ent-spline))
(progn
(and kuozhanshuju(kuozhanshuju
ent-spline
"length"
(list (vl-princ-to-string L-ALL))
"ALL"
))
(setq obj (vlax-ename->vla-object ent-spline))
(setq pts-sd (vlax-curve-getPointAtDist obj L-ALL))
(setq line-jzx-p2
(polar (vlax-curve-getPointAtDist obj L-ALL)
(+ (angle (vlax-curve-getPointAtDist
obj
(* L-ALL 0.99)
)
(vlax-curve-getPointAtDist
obj
(* L-ALL 1.01)
)
)
(* pi 0.5)
)
1
)
)
(setq line-jzx (vla-addLine
(vla-Get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(vlax-3D-Point
(vlax-curve-getPointAtDist obj L-ALL)
)
(vlax-3D-Point line-jzx-p2)
)
)
(setq line-jzx-ent (vlax-vla-object->ename line-jzx))
(VL-CMDF
"TRIM"
line-jzx-ent
""
(LIST ent-spline
(vlax-curve-getPointAtDist obj (* L-ALL 1.0125))
)
""
) ;(vlax-curve-getPointAtDist obj (* L-ALL 1.0125))
(entdel line-jzx-ent)
)
)
)
)
)
)
)
(defun c:hzytx () ($c:hzytxrun$ nil))
中文变量名，不常见啊 谢谢楼主分享！
页:
[1]