本帖最后由 xyp1964 于 2024-1-22 19:17 编辑
- (defun c:tt ()
- "线条宽度填充(保留对象)"
- (defun udist (bit kwd msg def bpt / inp)
- (if def
- (setq msg (strcat "\n" msg "<" (rtos def) ">: ")
- bit (* 2 (fix (/ bit 2)))
- )
- (setq msg (strcat "\n" msg ": "))
- )
- (initget bit kwd)
- (setq inp (if bpt (getdist msg bpt) (getdist msg)))
- (if inp inp def)
- )
- (command "undo" "be")
- (or dd (setq dd 10.))
- (setq dd (Udist 7 "" "宽度<输入或鼠标直接量取>" dd nil))
- (princ "\n选择对象直线或多段线:")
- (setq i -1)
- (if (setq ss (ssget '((0 . "line,LWPOLYLINE,arc"))))
- (while (setq s1 (ssname ss (setq i (1+ i))))
- (setq ob (vlax-ename->vla-object s1))
- (vla-Offset ob (* dd 0.5))
- (setq s2 (entlast))
- (vla-Offset ob (* dd -0.5))
- (setq s3 (entlast)
- s4 (entmakex (list '(0 . "LINE")
- (cons 10 (vlax-curve-getStartPoint s2))
- (cons 11 (vlax-curve-getStartPoint s3))
- )
- )
- s5 (entmakex (list '(0 . "LINE")
- (cons 10 (vlax-curve-getEndPoint s2))
- (cons 11 (vlax-curve-getEndPoint s3))
- )
- )
- )
- (command "-hatch" "p" "solid" "s" s2 s3 s4 s5 "" "")
- (command "ERASE" s2 s3 s4 s5 "")
- )
- )
- (command "undo" "e")
- (princ)
- )
|