;;辅助做剖面图
(defun c:fs_pmt	(/ a d l1 l2 nss obj ol p1 p2 pts ss)
  (or (and (setq l1 (car (fsxm-entsel "\n视图边界直线1:" '((0 . "line")))))
	   (setq l2 (car (fsxm-entsel "\n视图边界直线2:" '((0 . "line")))))
	   (princ "\n选择剖面线：")
	   (setq ss (ssget '((0 . "l*ine"))))
      )
      (fsxm-silenceexit)
  )
  (foreach l (fsxm-ss->enlist ss)
    (setq ol (vlax-ename->vla-object l))
    (setq d (entget l))
    (setq d (vl-remove-if-not
	      '(lambda (a) (vl-position (car a) '(10 11)))
	      d
	    )
	  d (mapcar 'cdr d)
    )
    (setq nss (ssget "F"
		     (mapcar '(lambda (a) (trans a 0 1)) d)
		     '((0 . "*line,circle,arc,ellipse")
		       (-4 . "<NOT")
		       (8 . "Hatch")
		       (-4 . "NOT>")
		      )
	      )
    )
    (ssdel l nss)
    (foreach en	(fsxm-ss->enlist nss)
      (setq ss (ssadd))
      (setq obj (vlax-ename->vla-object en))
      (setq pts (fsxm-interpt ol obj 0))
      (foreach pt pts
	(setq p1 (vlax-curve-getclosestpointto l1 pt t))
	(setq p2 (vlax-curve-getclosestpointto l2 pt t))
	(entmake (list '(0 . "line") (cons 10 p1) (cons 11 p2)))
	(ssadd (entlast) ss)
	(command ".matchprop" en ss "")
      )
    )
  )
  (princ)
)