截取多段线于精确两点

striver

;截取多段线于精确两点，适用于闭合多段线和非闭合多段线
(defun c:partCopy ()
  (setq entpnt0 (entsel "\n选择要截取的多段线："))
  (if (not entpnt0)
    (vl-exit-with-error "")
  )
  (if (not
        (wcmatch (cdr (assoc 0 (entget (car entpnt0)))) "*POLYLINE")
      )
    (vl-exit-with-error "")
  )
;;;  (redraw (car entpnt0) 3)

  (setq p1 (getpoint "\n指定第一个打断点："))
  (if (not p1)
    (vl-exit-with-error "")
  )
  (setq p2 (getpoint "\n指定第二个打断点："))
  (if (not p2)
    (vl-exit-with-error "")
  )
  (if (equal p1 p2 0.0001)
    (vl-exit-with-error "")
  )

  (if (isclosePL (car entpnt0))
    (progn
      (setq pmid (getpoint "\n指定中间点："))
      (if (not pmid)
        (vl-exit-with-error "")
      )
      (if (or (equal p1 pmid 0.0001) (equal p2 pmid 0.0001))
        (vl-exit-with-error "")
      )
    )
  )

  (setvar "cmdecho" 0)
  (command "undo" "be")

  (vla-copy (vlax-ename->vla-object (car entpnt0)))
  (setq ent (entlast))
  (setq entpnt (list ent (cadr entpnt0)))
  (setq vlaObj (vlax-ename->vla-object ent))
  (setq stapnt (vlax-curve-getStartPoint vlaObj))
  (setq endpnt (vlax-curve-getEndPoint vlaObj))

  (setq pt1 (vlax-curve-getclosestpointto ent p1)) ;取得最近点
  (setq para1 (vlax-curve-getParamAtPoint ent pt1)) ;取得参数
  (setq pt2 (vlax-curve-getclosestpointto ent p2)) ;取得最近点
  (setq para2 (vlax-curve-getParamAtPoint ent pt2)) ;取得参数

  (if (> para1 para2)
    (progn
      (setq tempval0719 pt1)
      (setq pt1 pt2)
      (setq pt2 tempval0719)
    )
  )

  (if (not (isclosePL (car entpnt0)))
    (progn
      (command "BREAK" entpnt "f" stapnt pt1)
      (command "BREAK" entpnt "f" pt2 endpnt)
    )
    (progn
      (setq ptmid (vlax-curve-getclosestpointto ent pmid)) ;取得最近点
      (setq paramid (vlax-curve-getParamAtPoint ent ptmid)) ;取得参数
      (if (between paramid para1 para2)
        (progn
          (if (equal stapnt pt1)
            (progn
              (setq para2 (vlax-curve-getParamAtPoint vlaObj pt2))
              (setq paraEnd (vlax-curve-getEndParam vlaObj))
              (setq para2E (/ (+ para2 paraEnd) 2.0))
              (setq pt2E (vlax-curve-getPointAtParam vlaObj para2E))
              (command "BREAK" entpnt "f" pt2 pt2E)
              (command "BREAK" entpnt "f" pt2E endpnt)
            )
            (progn
              (command "BREAK" entpnt "f" stapnt pt1)
              (command "BREAK" entpnt "f" pt2 endpnt)
            )
          )
        )
        (progn
          (command "BREAK" entpnt "f" pt1 pt2)
        )
      )

    )
  )

  (setq layerName "复线")
  (if (not (tblsearch "layer" layerName))
    (command "layer" "m" layerName "")
  )
  (command "chprop" ent "" "LA" layerName "")

  (command "undo" "e")
  (setvar "cmdecho" 1)

  (princ)
)

;判断是否介于二者之间
(defun between (mynum num1 num2)
  (> 0.0 (* (- mynum num1) (- mynum num2)))
)
;;;判断曲线是否闭合
(defun isclosePL (ent / ed)
  (setq ed (entget ent))
  (or (= 1 (cdr (assoc 70 ed)))
      (equal (assoc 10 ed) (assoc 10 (reverse ed)))
  )
)

kmliro_2017

不错，谢谢分享！！！！！！

kmliro_2017

不错，谢谢分享！！！！！！