 - (defun c:ha_apploop (/ $set_data e ss ptl pl)
- (defun $set_data (ss / sel ptl off_x)
- (xdrx_initget 6 "O B")
- (if (not (setq sel (getkword "\n选择方式[包围盒(B)/轮廓线(O)]<O>:")))
- (setq sel "O")
- )
- (if (= sel "O")
- (setq ptl (mapcar '(lambda(x)(xdrx_getsamplept x))(xdrx_pickset->ents (xdrx_searchoutline ss))))
- (setq ptl (list (xdrx_entity_box ss)))
- )
- (if ptl
- (progn
- (initget 4)
- (if (not (setq off_x (getreal "\n请输入便宜距离<0>:")))
- (setq off_x 0)
- )
- (if (/= off_x 0)
- (progn
- (setq ptl (mapcar
- '(lambda (x)
- (apply
- 'xdrx_pointsoffset
- (cons off_x x)
- )
- )
- ptl
- )
- )
- )
- (progn
- (if (= 1 (xdrx_yesorno "\n是否删除选择集<Y>"))
- (xdrx_entity_delete ss)
- )
- )
- )
- )
- )
- ptl
- )
- (xdrx_begin)
- (xdrx_sysvar_push "cmdecho")
- (setvar "cmdecho" 0)
- (if (and
- (progn
- (setq e (car (xdrx_entsel "\n请点取HATCH实体<退出>:" '((0 .
- "hatch"
- )
- )
- )
- )
- )
- (redraw e 3)
- t
- )
- (progn
- (xdrx_initssget "\n选取要添加到HATCH环(挖洞)的实体<退出>:")
- (setq ss (xdrx_ssget '((0 . "*line,arc,circle,ellipse"))))
- )
- )
- (progn
- (if (setq ptl ($set_data ss))
- (progn
- (mapcar
- '(lambda (x)
- (setq pl (xdrx_polyline_make x t))
- (xdrx_setpropertyvalue e "appendloop" (list 1 (entlast)))
- (xdrx_entity_delete pl)
- )
- ptl
- )
- )
- )
- )
- )
- (xdrx_sysvar_pop)
- (xdrx_end)
- (princ)
- )
|