右键你工具自定义右键单击，，改一下右键为确定就行，，，闭合的要不你发个图上来我看下是怎么回事？
麻烦看下哈
应该可以闭合了
本帖最后由 yaojing38 于 2023-6-15 10:32 编辑15062311027 发表于 2023-6-14 19:41
麻烦看下哈
;测量曲线上两点间的路程长度.
(defun C:qjcd (/ entName1 Pt1 Pt2 xLen st_pt end_pt pt_tmp l_ss PD pd1 obj)
(vl-load-com)
(setq entName1 (car (entselEx"\r请选择直线、圆弧、圆、多段线等曲线：" '((0 . "line,arc,circle,lwpolyline")))))
(if (= (cdr (assoc 0 (entget entName1))) "LWPOLYLINE") (curve:putclosed entName1))
(setq obj (vlax-ename->vla-object entName1))
(setq PD (< (distance (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) 0.0001))
(setq pt1 (getpoint "\n指定测量起点: ")
pt2 (getpoint "\n指定测量终点: ")
)
(setq
st_pt (vlax-curve-getStartPoint entName1)
end_pt (vlax-curve-getEndPoint entName1)
)
(setq entName2 entName1)
(if (>(vlax-curve-getParamAtPoint entName1 pt1) (vlax-curve-getParamAtPoint entName1 pt2))
(setq pt_tmp pt2
pt2 pt1
pt1 pt_tmp)
)
(vl-cmdf "undo" "be")
(vl-cmdf "_break" entName1 st_pt pt1)
(vl-cmdf "_break" entName1 end_pt pt2)
(vl-cmdf ".copy" entName1 "" '(0 0) '(0 0))
(setq l_ss (entget (entlast)))
(vl-cmdf "undo" "end")
(vl-cmdf "undo" "")
(entmake l_ss)
(setq entName1 (entlast))
(vla-put-Color (vlax-ename->vla-object entName1) 1)
(redraw entName1 3)
(initget 1 "T")
(setq pd1 (getstring "\n[取反向距离(T)]: ") )
(if (AND (or (= pd1 "t") (= pd1 "T")) PD)
(setq xLen (- (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) (abs (- (vlax-curve-getDistAtPoint entName1 pt1)(vlax-curve-getDistAtPoint entName1 pt2)))))
(setq xLen (abs (- (vlax-curve-getDistAtPoint entName1 pt1)(vlax-curve-getDistAtPoint entName1 pt2))))
)
(if (AND (or (= pd1 "t") (= pd1 "T")) PD)
(progn
(vl-cmdf "_erase"entName1 "")
(if (>(vlax-curve-getParamAtPoint entName2 pt1) (vlax-curve-getParamAtPoint entName2 pt2))
(setq pt_tmp pt2
pt2 pt1
pt1 pt_tmp)
)
(vl-cmdf "undo" "be")
(vl-cmdf "_break" entName2PT1 pt2 )
;(vl-cmdf "_break" entName1end_ptpt1)
(vl-cmdf ".copy" entName2 "" '(0 0) '(0 0))
(setq l_ss (entget (entlast)))
(vl-cmdf "undo" "end")
(vl-cmdf "undo" "")
(entmake l_ss)
(setq entName2 (entlast))
(vla-put-Color (vlax-ename->vla-object entName2) 1)
(redraw entName2 3)
(vl-cmdf "_erase"entName2)
)
)
(vl-cmdf "_erase"entName1"")
(princ (strcat "\n测量结果:两点间曲线长度=" (rtos xLen 2 2)))
;(princ "\n路径检查:查看亮显区域,右键退出")
(princ)
)
;;功能：带提示、关键字、过滤表、选择错误时的提示并且会亮显所选对像的entsel
;;用法：(entselEx提示信息 过滤表)
;;举例：(entselEx"\r请选择一个圆：" '((0 . "circle")) )
(defun entselEx (msg fil / el ss)
(while (and (setvar "errno" 0)
(not (and (setq el(entsel msg))
(if (= (type el) 'str)
el
(if (setq ss (ssget (cadr el) fil))
ss
(progn (princ ermsg) (setq ss nil))
);if
);if
);and
);not
(/= (getvar "errno") 52)
);and
);while
(if (= (type el) 'list) (redraw (car el) 3));亮显选中的对像
el
)
(defun curve:putclosed (obj)
; "使多段线封闭"
; "无"
; "(curve:putClosed (car (entsel)))"
(or (p:vlap obj)
(setq obj (vlax-ename->vla-object obj)))
(if (not (vlax-curve-isclosed obj))
(vla-put-closed obj :vlax-true)))
(defun p:vlap (obj)
; "判断是否vla对象."
(equal (type obj)
(quote vla-object))) yaojing38 发表于 2023-6-15 10:24
可以了 谢谢
页:
1
[2]