;;;============================
(defun c:ww (/ co ent i j lst lst1 lst2 lst3 pt pt1 pt2 pt3 pt4 pt5 r ss ss1 zh)
(setvar "cmdecho" 0)
(setq zh (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
(setq pt1 (getpoint "\n框选直线对象:")pt2 (getcorner pt1 "\指定对角点:")pt3 (list (car pt1) (cadr pt2))pt4 (list (car pt2) (cadr pt1))
ss (ssget "CP" (list pt1 pt3 pt2 pt4 pt1) '((0 . "LINE"))))
(repeat (setq i (sslength ss)) (redraw (ssname ss (setq i (1- i))) 3))
(setq pt5 (getpoint pt1 "\指定方向:") r (+ (* (fix (/ (angle pt1 pt5) (* 0.5 pi))) 0.5 pi) (* 0.25 pi))lst '())
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (setq i (1- i))))co (cdr (assoc 62 ent)))
(if (not (member co lst))
(progn
(setq lst (cons co lst)lst1 '() lst2 '() ss1 (ssget "CP" (list pt1 pt3 pt2 pt4 pt1) (list'(0 . "LINE"))))
(repeat (setq j (sslength ss1))
(setq ent (entget (ssname ss1 (setq j (1- j))))lst1 (cons (list (cdr (assoc 10 ent)) (cdr (assoc 11 ent))) lst1)))
(setq lst3 lst1)
(while lst3
(setq pt5 (car lst3))
(foreach j lst1
(if (and (setq pt (inters(car pt5)(cadr pt5)(car j)(cadr j))) (not (member pt lst2)))
(progn
(setq lst2 (cons pt lst2))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 62 (if co co 256)) '(100 . "AcDbPolyline") '(90 . 2)
(cons 10 pt) (cons 40 0.0) (cons 41 14.14) (cons 10 (polar pt r 7.07)))))));14.14为三角形长边, 7.07为长边一半
(setq lst3 (cdr lst3))))))
(repeat (setq i (sslength ss)) (redraw (ssname ss (setq i (1- i))) 4))
(setvar "ORTHOMODE" zh)
(princ)
)
页:
1
[2]