选矩形框画开门线

305341043 · 发表于 2018-9-19 17:29:00

如截图中：选择矩形框任意一条边上的点，由此边的中点画直线到对角的端点上。

lws0vrh0m3w.PNG

yshf · 发表于 2019-6-14 10:19:00

;试用以下程序
(defun c:kmx()
   (vl-load-com)
   (setq cmd (getvar "cmdecho"))
   (setq osm (getvar "osmode"))
   (setvar "cmdecho" 0)
   (setvar "osmode" 0)
   (command "_undo" "be")
   (while (setq ssa (ssget ":S" '((0 . "LWPOLYLINE"))))
      (setq entx (car (ssnamex ssa)))
      (setq obj  (vlax-ename->vla-object (cadr entx)))
      (setq pae  (vlax-curve-getendparam obj))
      (if (or (and (= pae 4.0) (= (vlax-curve-isClosed obj) t))
               (and (= pae 4.0) (equal (vlax-curve-getstartpoint obj) (vlax-curve-getendpoint obj)))
            )
            (progn
               (setq pt (cadr (last entx)))
               (setq pt0  (vlax-curve-getclosestpointto obj pt))
               (setq par  (vlax-curve-getparamatpoint obj pt0))
               (setq pai  (fix par))
               (setq pai-1 (- pai 1.0))
               (if ( pai+1 pae) (setq pai+1 (- pai+1 pae)))
               (setq pmid  (vlax-curve-getpointatparam obj (+ pai 0.5)))
               (setq pt1 (vlax-curve-getpointatparam obj pai-1))
               (setq pt2 (vlax-curve-getpointatparam obj pai+1))
               (command "_pline" pt1 pmid pt2 "")
         )
         (alert "你所选取的不由4点组成的闭合矩形!")
      )
   )
   (command "_undo" "e")
   (setvar "osmode" osm)
   (setvar "cmdecho" cmd)
   (princ)
)