关于多段线

/db_自贡黄明儒_ · 发表于 2013-10-31 09:12:03

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 /db_自贡黄明儒_ 于 2013-11-2 16:49 编辑

;;164.1 [功能] 曲线是否封闭
;;164.2 [功能]使多段线封闭
;;164.3 [功能] 多段线端点列表
;;164.4 [功能] 矩形中点坐标
;;164.5 [功能] 参数param处的切线方向的角度
;;164.6 [功能] 参数param处的法线方向的角度
;;164.7 [功能] 曲线一点的切线方向的角度
;;164.8 [功能] 曲线一点的法线方向的角度
;;164.9 [功能] 去除多段线重点
;;164.10 [功能] 判断点是否在曲线上
;;164.11 [功能] 曲线长度
;;164.12 [功能] 多段线子段数量
;;164.13 [功能] 曲线中点
;;164.14 [功能] 曲线一点的参数param
;;164.15 [功能] 参数param处的坐标
;;164.16 [功能] 多段线第n子段的起点坐标
;;164.17 [功能] 多段线第n子段的终点坐标
;;164.18 [功能] 多段线所点击子段的两端点列表
;;164.19 [功能] 多段线所点击点最近的一个顶点
;;164.20 [功能] 多段线所点击子段param(索引)
;;164.21 [功能] 多段线所点击子段的起点坐标
;;164.22 [功能] 多段线所点击子段的终点坐标
;;164.23 [功能] 多段线所击点离起点近
;;164.24 [功能] 所击多段线子段是否是直线(返回nil是弧)
;;164.25 [功能] 求多段线上的弧段(圆或圆弧也有效)的圆心 by caoyin
;;164.26 [功能] 求多段线上的弧段(圆或圆弧也有效)的圆心
;;164.27 [功能] 判断多段线是否有圆弧(凸度/=0)的子段
;;164.28 [功能] 连接线、弧成多段线
;;164.29 [功能] 构造矩形 by highflybird
;;164.30 [功能] 点表生成多段线
;;164.31 [功能] 多段线反向(起点反成终点) byzml84
(还未出生)
;;164.32 [功能] 多段线删除顶点
;;164.33 [功能] 多段线增加顶点
;;164.34 [功能] 多段线修改顶点
;;164.35 [功能] 多段线拷贝子段

;;164.1 [功能] 曲线是否封闭
;;示例(HH:isClosed (car (entsel)))
(defun HH:isClosed (obj)
(vlax-curve-isClosed obj)
)
;;164.2 [功能]使多段线封闭
(defun HH:MakeClosed (en / OBJ)
(cond ((equal (type en) 'ENAME) (setq obj (vlax-ename->vla-object en)))
((equal (type en) 'ENAME) (setq obj en))
(T (exit))
)
;;(if (equal (vlax-get obj 'Closed) 0) (vlax-put obj 'Closed -1))
(if (not (vlax-curve-isclosed obj)) ;(equal (vlax-get-property obj 'closed) :vlax-false)
(vla-put-closed obj :vlax-true)
)
)
;;164.3 [功能] 多段线端点列表
;;示例(HH:PtLists (car (entsel)))
(defun HH:PtLists (en)
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
)
)
;;164.4 [功能] 矩形中点坐标
;;示例(HH:RectangCen (car (entsel)))
(defun HH:RectangCen (en / PL X Y)
(setq pl (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en)))
(setq pl (mapcar 'cdr pl))
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car pl) (caddr pl))
)
;;164.5 [功能] 参数param处的切线方向的角度
;;示例(HH:ParamFirstAngle (car (entsel)) 1)
;;注1 (vlax-curve-getFirstDeriv obj param) 函数计算的值是曲线上在参数值为param点处的切线方向
;;注2 param起始值为0
(defun HH:ParamFirstAngle (obj param)
(setq pt (vlax-curve-getpointatparam obj param))
(angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv obj param)))
)
;;164.6 [功能] 参数param处的法线方向的角度
;;示例(HH:ParamSecondAngle (car (entsel)) 1)
;;注:param处是直线，则返回0.0
(defun HH:ParamSecondAngle (obj param)
(setq pt (vlax-curve-getpointatparam obj param))
(angle pt (mapcar '+ pt (vlax-curve-getSecondDeriv obj param)))
)
;;164.7 [功能] 曲线一点的切线方向的角度
;;示例(HH:PtFirstAngle (car (entsel)) (getpoint))
(defun HH:PtFirstAngle (obj pt)
(setq param (vlax-curve-getParamAtPoint obj pt))
(angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv obj param)))
)
;;164.8 [功能] 曲线一点的法线方向的角度
;;示例(HH:PtSecondAngle (car (entsel)) (getpoint))
(defun HH:PtSecondAngle (obj pt)
(setq param (vlax-curve-getParamAtPoint obj pt))
(angle pt (mapcar '+ pt (vlax-curve-getSecondDeriv obj param)))
)
;;164.9 [功能] 去除多段线重点
;;示例(HH:Remove (car (entsel)))
(defun HH:Remove (en / NEWDATA)
(foreach e (entget en)
(if (and (member e newdata) (= 10 (car e)))
nil
(setq newdata (cons e newdata))
)
)
(entmod (reverse newdata))
)
;;164.10 [功能] 判断点是否在曲线上
;;示例(HH:PtOnCurve (getpoint) (car (entsel)))
(defun HH:PtOnCurve (pt curve)
(equal pt (vlax-curve-getClosestPointTo curve pt) 0.00001)
)
;;164.11 [功能] 曲线长度
;;直线、圆弧、圆、多段线、优化多段线、样条曲线等图元
;;示例 (HH:GetCurveLength (car (entsel)))
(defun HH:GetCurveLength (curve)
(vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve))
)
;;164.12 [功能] 多段线子段数量
;;相当于组码90
;;示例 (HH:GetCurveNum (car (entsel)))
(defun HH:GetCurveNum (obj)
(if (vlax-curve-isClosed obj)
(fix (1- (vlax-curve-getendParam obj)))
(fix (vlax-curve-getendParam obj))
)
)
;;164.13 [功能] 曲线中点
;;示例 (HH:GetMidpointCurve (car (entsel)))
(defun HH:GetMidpointCurve (curve / d)
(setq d (/ (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve)) 2))
(vlax-curve-getPointAtDist curve d)
)
;;164.14 [功能] 曲线一点的参数param
;;(HH:PtToParam (car (entsel)) (getpoint))
(defun HH:PtToParam (obj pt)
(vlax-curve-getParamAtPoint obj pt)
)
;;164.15 [功能] 参数param处的坐标
;;(HH:ParamTopt (car (entsel)) 0)
(defun HH:ParamTopt (obj param)
(vlax-curve-getPointAtParam obj param)
)
;;164.16 [功能] 多段线第n子段的起点坐标
;;示例 (HH:GetSegStratPt (car (entsel)) 0)
(defun HH:GetSegStratPt (curve n)
(vlax-curve-getPointAtParam curve (fix n))
)
;;164.17 [功能] 多段线第n子段的终点坐标
;;示例 (HH:GetSegEndPt (car (entsel)) 0)
(defun HH:GetSegEndPt (curve n)
(vlax-curve-getPointAtParam curve (1+ (fix n)))
)
;;164.18 [功能] 多段线所点击子段的两端点列表
;;示例(HH:PickSegEndPt (car(setq en(entsel))) (cadr en))
(defun HH:PickSegEndPt (obj p / pp n)
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n (fix (vlax-curve-getparamatpoint obj pp))
)
(list (vlax-curve-getPointAtParam obj n)
(vlax-curve-getPointAtParam obj (1+ n))
)
)
;;164.19 [功能] 多段线所点击点最近的一个顶点
;;示例(HH:PickClosePt (car(setq en(entsel))) (cadr en))
(defun HH:PickClosePt (obj p / N P1 P2 PP)
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n (fix (vlax-curve-getparamatpoint obj pp))
)
(setq p1 (vlax-curve-getPointAtParam obj n))
(setq p2 (vlax-curve-getPointAtParam obj (1+ n)))
(if (< (distance pp p1) (distance pp p2))
p1
p2
)
)
;;164.20 [功能] 多段线所点击子段param(索引)
;;示例(HH:PickSegIndex (car(setq en(entsel))) (cadr en))
(defun HH:PickSegIndex (obj p / PP)
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0)))
(fix (vlax-curve-getparamatpoint obj pp))
)
;;164.21 [功能] 多段线所点击子段的起点坐标
;;示例(HH:PickSegStratPt (car(setq en(entsel))) (cadr en))
(defun HH:PickSegStratPt (obj p / pp n)
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n (fix (vlax-curve-getparamatpoint obj pp))
)
(vlax-curve-getPointAtParam obj n)
)
;;164.22 [功能] 多段线所点击子段的终点坐标
;;示例(HH:PickSegEndPt (car(setq en(entsel))) (cadr en))
(defun HH:PickSegEndPt (obj p / pp n)
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n (fix (vlax-curve-getparamatpoint obj pp))
)
(vlax-curve-getPointAtParam obj (1+ n))
)
;;164.23 [功能] 多段线所击点离起点近
;;示例(HH:PickToStart (car(setq en(entsel))) (cadr en))
(defun HH:PickToStart (curve p / L1 L2 PP)
(setq pp (vlax-curve-getclosestpointto curve (trans p 1 0)))
(setq L2 (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve)))
(setq L1 (vlax-curve-getDistAtPoint curve pp))
(> (- L2 L1) L1)
)
;;164.24 [功能] 多段线所击子段是否是直线(返回nil是弧)
;;示例(HH:PickArc (car(setq en(entsel))) (cadr en))
(defun HH:PickArc (curve p / PP)
(setq pp (vlax-curve-getclosestpointto curve (trans p 1 0)))
(setq pp (vlax-curve-getSecondDeriv
curve
(fix (vlax-curve-getparamatpoint curve pp))
)
)
(equal pp '(0.0 0.0 0.0))
)
;;164.25 [功能] 求多段线上的弧段(圆或圆弧也有效)的圆心 by caoyin
;;(HH:GetCenter1 (entsel "\n选择多段线弧段: "))
(defun HH:GetCenter1 (EP / E P)
(mapcar 'set '(E P) EP)
(setq P (apply 'vlax-curve-getClosestPointTo EP))
(mapcar '+
P
(vlax-curve-getsecondderiv
E
(vlax-curve-getParamAtPoint E P)
)
)
)
;;164.26 [功能] 求多段线上的弧段(圆或圆弧也有效)的圆心
;;(HH:GetCenter2 (car(setq en(entsel))) (cadr en))
(defun HH:GetCenter2 (curve p / PP)
(setq pp (vlax-curve-getclosestpointto curve (trans p 1 0)))
(mapcar '+
pp
(vlax-curve-getsecondderiv
curve
(vlax-curve-getParamAtPoint curve pp)
)
)
)
;;164.27 [功能] 判断多段线是否有圆弧(凸度/=0)的子段
;;(HH:checkarc1 (car (entsel)))
(defun HH:checkarc1 (en / BU N OBJ PLIST)
(setq obj (vlax-ename->vla-object en))
(setq plist (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj))))
(setq n 0)
(repeat (/ (length plist) 2)
(if (/= (vla-getbulge obj n) 0)
(setq bu T)
)
(setq n (+ n 1))
)
bu
)
;;164.28 [功能] 判断多段线是否有圆弧(凸度/=0)的子段
;;(HH:checkarc2 (car (entsel)))
(defun HH:checkarc2 (en / G)
(setq G (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget en)))
(not (vl-every 'zerop (mapcar 'cdr G)));(vl-remove 0.0 (mapcar 'cdr G))
)
;;164.29 [功能] 连接线、弧成多段线
;;(HH:JionToPolyline)
(defun HH:JionToPolyline (/ PET SS)
(setq pet (getvar "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
(while (setq ss (ssget '((0 . "ARC,*LINE"))))
(command "_.pedit" (ssname ss 0) "j" ss "" "")
)
(setvar "PEDITACCEPT" pet)
(princ)
)
;;164.30 [功能] 构造矩形 by highflybird
(defun Make-Rectange (pt1 pt2)
(entmake
(list
'(0 . "LWPOLYLINE") ;轻多段线
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4) ;四个顶点
'(70 . 1) ;闭合
(cons 38 (caddr pt1)) ;高程
(cons 10 (list (car pt1) (cadr pt1))) ;左下角
(cons 10 (list (car pt2) (cadr pt1))) ;右下角
(cons 10 (list (car pt2) (cadr pt2))) ;右上角
(cons 10 (list (car pt1) (cadr pt2))) ;左上角
(cons 210 '(0 0 1)) ;法线方向
)
)
)
;;164.31 [功能] 点表生成多段线
(defun Make-LWPOLYLINE (lst / PT)
(entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
)
(mapcar '(lambda (pt) (cons 10 pt)) lst)
)
)
)
;;164.32 [功能] 多段线反向(起点反成终点) byzml84
;;(HH:LWPOLYLINEFX (car (entsel)))
(defun HH:LWPOLYLINEFX (EN / A B C D ENT LST LST1 TMP)
(setq ENT (entget EN))
(setq tmp ent)
(while (setq tmp (member (assoc 10 tmp) tmp))
(setq a (assoc 10 tmp)
b (cons 40 (cdr (assoc 41 tmp)))
c (cons 41 (cdr (assoc 40 tmp)))
d (cons 42 (- (cdr (assoc 42 tmp))))
LST (append (list b c d a) LST)
)
(setq tmp (cddddr tmp))
)
(repeat 3 (setq LST (append (cdr lst) (list (car lst)))))
(setq lst1 (reverse (cdr (member (assoc 10 ent) (reverse ent)))))
(entmod (append lst1 lst '((210 0 0 1))))
)

;;164.1 [功能] 曲线是否封闭 
;;示例(HH:isClosed (car (entsel))) 
(defun HH:isClosed (obj) 
  (vlax-curve-isClosed obj) 
) 
;;164.2 [功能]使多段线封闭 
(defun HH:MakeClosed (en / OBJ) 
  (cond ((equal (type en) 'ENAME) (setq obj (vlax-ename->vla-object en))) 
((equal (type en) 'ENAME) (setq obj en)) 
(T (exit)) 
  ) 
  ;;(if (equal (vlax-get obj 'Closed) 0) (vlax-put obj 'Closed -1)) 
  (if (not (vlax-curve-isclosed obj))       ;(equal (vlax-get-property obj 'closed) :vlax-false) 
    (vla-put-closed obj :vlax-true) 
  ) 
) 
;;164.3 [功能] 多段线端点列表 
;;示例(HH:PtLists (car (entsel))) 
(defun HH:PtLists (en) 
  (mapcar 'cdr 
   (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en)) 
  ) 
) 
;;164.4 [功能] 矩形中点坐标 
;;示例(HH:RectangCen (car (entsel))) 
(defun HH:RectangCen (en / PL X Y) 
  (setq pl (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))) 
  (setq pl (mapcar 'cdr pl)) 
  (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) (car pl) (caddr pl)) 
) 
;;164.5 [功能] 参数param处的切线方向的角度 
;;示例(HH:ParamFirstAngle (car (entsel)) 1) 
;;注1 (vlax-curve-getFirstDeriv obj param) 函数计算的值是曲线上在参数值为param点处的切线方向 
;;注2 param起始值为0 
(defun HH:ParamFirstAngle (obj param) 
  (setq pt (vlax-curve-getpointatparam obj param)) 
  (angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv obj param))) 
) 
;;164.6 [功能] 参数param处的法线方向的角度 
;;示例(HH:ParamSecondAngle (car (entsel)) 1) 
;;注:param处是直线，则返回0.0 
(defun HH:ParamSecondAngle (obj param) 
  (setq pt (vlax-curve-getpointatparam obj param)) 
  (angle pt (mapcar '+ pt (vlax-curve-getSecondDeriv obj param))) 
) 
;;164.7 [功能] 曲线一点的切线方向的角度 
;;示例(HH:PtFirstAngle (car (entsel)) (getpoint)) 
(defun HH:PtFirstAngle (obj pt) 
  (setq param (vlax-curve-getParamAtPoint obj pt)) 
  (angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv obj param))) 
) 
;;164.8 [功能] 曲线一点的法线方向的角度 
;;示例(HH:PtSecondAngle (car (entsel)) (getpoint)) 
(defun HH:PtSecondAngle (obj pt) 
  (setq param (vlax-curve-getParamAtPoint obj pt)) 
  (angle pt (mapcar '+ pt (vlax-curve-getSecondDeriv obj param))) 
) 
;;164.9 [功能] 去除多段线重点 
;;示例(HH:Remove (car (entsel))) 
(defun HH:Remove (en / NEWDATA) 
  (foreach e (entget en) 
    (if (and (member e newdata) (= 10 (car e))) 
      nil 
      (setq newdata (cons e newdata)) 
    ) 
  ) 
  (entmod (reverse newdata)) 
) 
;;164.10 [功能] 判断点是否在曲线上 
;;示例(HH:PtOnCurve (getpoint) (car (entsel))) 
(defun HH:PtOnCurve (pt curve) 
  (equal pt (vlax-curve-getClosestPointTo curve pt) 0.00001) 
) 
;;164.11 [功能] 曲线长度 
;;直线、圆弧、圆、多段线、优化多段线、样条曲线等图元 
;;示例 (HH:GetCurveLength (car (entsel))) 
(defun HH:GetCurveLength (curve) 
  (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve)) 
) 
;;164.12 [功能] 多段线子段数量 
;;相当于组码90 
;;示例 (HH:GetCurveNum (car (entsel))) 
(defun HH:GetCurveNum (obj) 
  (if (vlax-curve-isClosed obj) 
    (fix (1- (vlax-curve-getendParam obj))) 
    (fix (vlax-curve-getendParam obj)) 
  ) 
) 
;;164.13 [功能] 曲线中点 
;;示例 (HH:GetMidpointCurve (car (entsel))) 
(defun HH:GetMidpointCurve (curve / d) 
  (setq d (/ (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve)) 2)) 
  (vlax-curve-getPointAtDist curve d) 
) 
;;164.14 [功能] 曲线一点的参数param 
;;(HH:PtToParam (car (entsel)) (getpoint)) 
(defun HH:PtToParam (obj pt) 
  (vlax-curve-getParamAtPoint obj pt) 
) 
;;164.15 [功能] 参数param处的坐标 
;;(HH:ParamTopt (car (entsel)) 0) 
(defun HH:ParamTopt (obj param) 
  (vlax-curve-getPointAtParam obj param) 
) 
;;164.16 [功能] 多段线第n子段的起点坐标 
;;示例 (HH:GetSegStratPt (car (entsel)) 0) 
(defun HH:GetSegStratPt (curve n) 
  (vlax-curve-getPointAtParam curve (fix n)) 
) 
;;164.17 [功能] 多段线第n子段的终点坐标 
;;示例 (HH:GetSegEndPt (car (entsel)) 0) 
(defun HH:GetSegEndPt (curve n) 
  (vlax-curve-getPointAtParam curve (1+ (fix n))) 
) 
;;164.18 [功能] 多段线所点击子段的两端点列表 
;;示例(HH:PickSegEndPt (car(setq en(entsel))) (cadr en)) 
(defun HH:PickSegEndPt (obj p / pp n) 
  (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0)) 
n  (fix (vlax-curve-getparamatpoint obj pp)) 
  ) 
  (list (vlax-curve-getPointAtParam obj n) 
(vlax-curve-getPointAtParam obj (1+ n)) 
  ) 
) 
;;164.19 [功能] 多段线所点击点最近的一个顶点 
;;示例(HH:PickClosePt (car(setq en(entsel))) (cadr en)) 
(defun HH:PickClosePt (obj p / N P1 P2 PP) 
  (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0)) 
n  (fix (vlax-curve-getparamatpoint obj pp)) 
  ) 
  (setq p1 (vlax-curve-getPointAtParam obj n)) 
  (setq p2 (vlax-curve-getPointAtParam obj (1+ n))) 
  (if (< (distance pp p1) (distance pp p2)) 
    p1 
    p2 
  ) 
) 
;;164.20 [功能] 多段线所点击子段param(索引) 
;;示例(HH:PickSegIndex (car(setq en(entsel))) (cadr en)) 
(defun HH:PickSegIndex (obj p / PP) 
  (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))) 
  (fix (vlax-curve-getparamatpoint obj pp)) 
) 
;;164.21 [功能] 多段线所点击子段的起点坐标 
;;示例(HH:PickSegStratPt (car(setq en(entsel))) (cadr en)) 
(defun HH:PickSegStratPt (obj p / pp n) 
  (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0)) 
n  (fix (vlax-curve-getparamatpoint obj pp)) 
  ) 
  (vlax-curve-getPointAtParam obj n) 
) 
;;164.22 [功能] 多段线所点击子段的终点坐标 
;;示例(HH:PickSegEndPt (car(setq en(entsel))) (cadr en)) 
(defun HH:PickSegEndPt (obj p / pp n) 
  (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0)) 
n  (fix (vlax-curve-getparamatpoint obj pp)) 
  ) 
  (vlax-curve-getPointAtParam obj (1+ n)) 
) 
;;164.23 [功能] 多段线所击点离起点近 
;;示例(HH:PickToStart (car(setq en(entsel))) (cadr en)) 
(defun HH:PickToStart (curve p / L1 L2 PP) 
  (setq pp (vlax-curve-getclosestpointto curve (trans p 1 0))) 
  (setq L2 (vlax-curve-getDistAtParam curve (vlax-curve-getEndParam curve))) 
  (setq L1 (vlax-curve-getDistAtPoint curve pp)) 
  (> (- L2 L1) L1) 
) 
;;164.24 [功能] 多段线所击子段是否是直线(返回nil是弧) 
;;示例(HH:PickArc (car(setq en(entsel))) (cadr en)) 
(defun HH:PickArc (curve p / PP) 
  (setq pp (vlax-curve-getclosestpointto curve (trans p 1 0))) 
  (setq pp (vlax-curve-getSecondDeriv 
      curve 
      (fix (vlax-curve-getparamatpoint curve pp)) 
    ) 
  ) 
  (equal pp '(0.0 0.0 0.0)) 
) 
;;164.25 [功能] 求多段线上的弧段(圆或圆弧也有效)的圆心 by caoyin 
;;(HH:GetCenter1 (entsel "\n选择多段线弧段: ")) 
(defun HH:GetCenter1 (EP / E P) 
  (mapcar 'set '(E P) EP) 
  (setq P (apply 'vlax-curve-getClosestPointTo EP)) 
  (mapcar '+ 
   P 
   (vlax-curve-getsecondderiv 
     E 
     (vlax-curve-getParamAtPoint E P) 
   ) 
  ) 
) 
;;164.26 [功能] 求多段线上的弧段(圆或圆弧也有效)的圆心 
;;(HH:GetCenter2 (car(setq en(entsel))) (cadr en)) 
(defun HH:GetCenter2 (curve p / PP) 
  (setq pp (vlax-curve-getclosestpointto curve (trans p 1 0))) 
  (mapcar '+ 
   pp 
   (vlax-curve-getsecondderiv 
     curve 
     (vlax-curve-getParamAtPoint curve pp) 
   ) 
  ) 
) 
;;164.27 [功能] 判断多段线是否有圆弧(凸度/=0)的子段 
;;(HH:checkarc1 (car (entsel))) 
(defun HH:checkarc1 (en / BU N OBJ PLIST) 
  (setq obj (vlax-ename->vla-object en)) 
  (setq plist (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj)))) 
  (setq n 0) 
  (repeat (/ (length plist) 2) 
    (if (/= (vla-getbulge obj n) 0) 
      (setq bu T) 
    ) 
    (setq n (+ n 1)) 
  ) 
  bu 
) 
;;164.28 [功能] 判断多段线是否有圆弧(凸度/=0)的子段 
;;(HH:checkarc2 (car (entsel))) 
(defun HH:checkarc2 (en / G) 
  (setq G (vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget en))) 
  (not (vl-every 'zerop (mapcar 'cdr G)));(vl-remove 0.0 (mapcar 'cdr G)) 
) 
;;164.29 [功能] 连接线、弧成多段线 
;;(HH:JionToPolyline) 
(defun HH:JionToPolyline (/ PET SS) 
  (setq pet (getvar "PEDITACCEPT")) 
  (setvar "PEDITACCEPT" 1) 
  (while (setq ss (ssget '((0 . "ARC,*LINE")))) 
    (command "_.pedit" (ssname ss 0) "j" ss "" "") 
  ) 
  (setvar "PEDITACCEPT" pet) 
  (princ) 
) 
;;164.30 [功能] 构造矩形 by highflybird 
(defun Make-Rectange (pt1 pt2) 
  (entmake 
    (list 
      '(0 . "LWPOLYLINE")        ;轻多段线 
      '(100 . "AcDbEntity") 
      '(100 . "AcDbPolyline") 
      '(90 . 4)          ;四个顶点 
      '(70 . 1)          ;闭合 
      (cons 38 (caddr pt1))        ;高程 
      (cons 10 (list (car pt1) (cadr pt1)))      ;左下角 
      (cons 10 (list (car pt2) (cadr pt1)))      ;右下角 
      (cons 10 (list (car pt2) (cadr pt2)))      ;右上角 
      (cons 10 (list (car pt1) (cadr pt2)))      ;左上角 
      (cons 210 '(0 0 1))        ;法线方向 
    ) 
  ) 
) 
;;164.31 [功能] 点表生成多段线 
(defun Make-LWPOLYLINE (lst / PT) 
  (entmake (append (list '(0 . "LWPOLYLINE") 
    '(100 . "AcDbEntity") 
    '(100 . "AcDbPolyline") 
    (cons 90 (length lst)) 
     ) 
     (mapcar '(lambda (pt) (cons 10 pt)) lst) 
    ) 
  ) 
) 
;;164.32 [功能] 多段线反向(起点反成终点) byzml84 
;;(HH:LWPOLYLINEFX (car (entsel))) 
(defun HH:LWPOLYLINEFX (EN / A B C D ENT LST LST1 TMP) 
  (setq ENT (entget EN)) 
  (setq tmp ent) 
  (while (setq tmp (member (assoc 10 tmp) tmp)) 
    (setq a   (assoc 10 tmp) 
   b   (cons 40 (cdr (assoc 41 tmp))) 
   c   (cons 41 (cdr (assoc 40 tmp))) 
   d   (cons 42 (- (cdr (assoc 42 tmp)))) 
   LST (append (list b c d a) LST) 
    ) 
    (setq tmp (cddddr tmp)) 
  ) 
  (repeat 3 (setq LST (append (cdr lst) (list (car lst))))) 
  (setq lst1 (reverse (cdr (member (assoc 10 ent) (reverse ent))))) 
  (entmod (append lst1 lst '((210 0 0 1)))) 
)

st788796 · 发表于 2013-10-31 09:30:31

是否闭合 (vlax-curve-isclosed curve) 或者
(or (vlax-curve-isclosde curve) (equal (vlax-curve-getstartpoint curve) (vlax-curve-getendpoint curve) 1e-9))

/db_自贡黄明儒_ · 发表于 2013-10-31 09:33:32

st788796 发表于 2013-10-31 09:30
是否闭合 (vlax-curve-isclosed curve) 或者
(or (vlax-curve-isclosde curve) (equal (vlax-curve-getsta ...

样条曲线可以使其闭合吗？

st788796 · 发表于 2013-10-31 09:37:07

/db_自贡黄明儒_ 发表于 2013-10-31 09:33
样条曲线可以使其闭合吗？

(defun Pl:SetClosed (pl)
(if (= (type pl) 'ENAME)
(setq pl (vlax-ename->vla-object pl))
)
(vla-put-closed pl :vlax-true)
)

st788796 · 发表于 2013-10-31 09:53:12

可以这样仿写 XDAPI

(defun dxf (code el)
(cdr (assoc code el))
)
(defun pl:NumVerts (e)
(dxf 90 (entget e))
)
(defun Pl:IsOnlyLines (e)
(vl-every 'zerop
(vl-remove-if-not '(lambda (x) (= (car x) 42)) (entget e))
)
)

ysq101 · 发表于 2013-10-31 10:04:15

好东东啊....支持黄工....先收藏了

/db_自贡黄明儒_ · 发表于 2013-10-31 10:16:06

st788796 发表于 2013-10-31 09:53
可以这样仿写 XDAPI

你没有注解，这是判断多段线是否有凸度吧，很不错。

风冷雨 · 发表于 2013-10-31 10:51:35

好东西，值得分享。。。。。。

zyhandw · 发表于 2013-10-31 10:52:30

感谢黄大侠的分享，有心人！

/db_自贡黄明儒_ · 发表于 2013-10-31 11:03:14

st788796 发表于 2013-10-31 09:37

样条曲线不行吧，我试过了。一试就出错

SmartStar · 发表于 2013-10-31 12:51:39

黄老大，是不是晚上做梦都是lisp啊:lol

q3_2006 · 发表于 2013-10-31 14:48:45

黄工，能下载到的最近版是130622版，最后一个函数是：
;;152 [功能] 局部更新
今天是
;;164.1 [功能] 曲线是否封闭
拜托中间断掉的给补补吧！

HLCAD · 发表于 2013-10-31 15:33:22

黄大侠的大作，一定要顶！

st788796 · 发表于 2013-10-31 16:04:55

/db_自贡黄明儒_ 发表于 2013-10-31 11:03
样条曲线不行吧，我试过了。一试就出错

查了下在 2014 下 Spline 要用 (vla-put-closed2 (vlax-ename->vla-object (car entsel)) :vlax-true)就可以闭合 Spline

good32167 · 发表于 2014-9-3 16:17:04

从明经追到这里了呵呵

账号		自动登录	找回密码
密码			立即注册

[研讨] 关于多段线

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

点评

点评

点评

点评

点评

点评

点评

评分