过一点画多段线一条边的平行xline线怎么写?

jzf1987

过一点画多段线一条边的平行xline线怎么写?最好能注释下.

yshf

2. (defun c:ccc()
   
3.     (if (progn
   
4.             (progn "\n请选择多段线: ")
   
5.             (setq EntSsa (ssget ":S" '((0 . "lwpolyline"))))
   
6.         )
   
7.         (progn
   
8.             (mapcar 'set '(pai Ent pan PPt) (car (ssnamex EntSsa)))
   
9.             (setq PPt (cadr PPt)) ;选择多段线时的拾取点
   
10.             (If (setq Pt (getpoint PPt "\n请指定构造线通过点: "))
    
11.                 (progn
    
12.                     (setq OBj (vlax-ename->vla-object Ent))
    
13.                     ;多段线上距拾取点最近的点
    
14.                     (setq Pt0 (vlax-curve-getclosestpointto OBj PPt))
    
15.                     (setq par (vlax-curve-getParamAtPoint OBj Pt0))
    
16.                     (setq pai (fix par))
    
17.                     (setq pan (vlax-curve-getendparam Obj))
    
18.                     ;拾取点所在子段的凸度(等于0为直线段，否则为圆弧段)
    
19.                     (setq bul (vla-GetBulge OBj pai))
    
20.                     (if (and (or (not (equal pai 0   1e-6)) ;不是起点
    
21.                                  (not (equal pai pan 1e-6)) ;不是止点
    
22.                              )
    
23.                              (equal bul 0 1e-6) ;子段不是圆弧
    
24.                         )
    
25.                         (progn
    
26.                             ;过Pt0点的切线方向向量
    
27.                             (setq ptv (vlax-curve-getFirstDeriv Obj par))
    
28.                             ;; 创建构造线
    
29.                             (entmake (list '(0 . "XLINE")
    
30.                                            '(100 . "AcDbEntity")
    
31.                                            '(100 . "AcDbXline")
    
32.                                             (cons 10 Pt)
    
33.                                             (cons 11 Ptv)
    
34.                                      )
    
35.                              )
    
36.                         )
    
37.                     )
    
38.                     
    
39.                 )
    
40.             )
    
41.         )
    
42.     )
    
43. )

(defun c:ccc()<br />     (if (progn <br />             (progn "\n请选择多段线: ")<br />             (setq EntSsa (ssget ":S" '((0 . "lwpolyline"))))<br />         )<br />         (progn<br />             (mapcar 'set '(pai Ent pan PPt) (car (ssnamex EntSsa)))<br />             (setq PPt (cadr PPt)) ;选择多段线时的拾取点<br />             (If (setq Pt (getpoint PPt "\n请指定构造线通过点: "))<br />                 (progn<br />                     (setq OBj (vlax-ename->vla-object Ent))<br />                     ;多段线上距拾取点最近的点<br />                     (setq Pt0 (vlax-curve-getclosestpointto OBj PPt))<br />                     (setq par (vlax-curve-getParamAtPoint OBj Pt0))<br />                     (setq pai (fix par))<br />                     (setq pan (vlax-curve-getendparam Obj))<br />                     ;拾取点所在子段的凸度(等于0为直线段，否则为圆弧段)<br />                     (setq bul (vla-GetBulge OBj pai))<br />                     (if (and (or (not (equal pai 0   1e-6)) ;不是起点<br />                                  (not (equal pai pan 1e-6)) ;不是止点<br />                              )<br />                              (equal bul 0 1e-6) ;子段不是圆弧<br />                         )<br />                         (progn<br />                             ;过Pt0点的切线方向向量<br />                             (setq ptv (vlax-curve-getFirstDeriv Obj par))<br />                             ;; 创建构造线<br />                             (entmake (list '(0 . "XLINE")<br />                                            '(100 . "AcDbEntity")<br />                                            '(100 . "AcDbXline")<br />                                             (cons 10 Pt)<br />                                             (cons 11 Ptv)<br />                                      )<br />                              )<br />                         )<br />                     )<br />                     <br />                 )<br />             )<br />         )<br />     )<br /> )

caoyin

1. ;; 绘制多段线指定段的平行线(构造线)
   
2. (defun C:TT (/ EName PckPnt Point PckPnt2 Vector)
   
3. 
   
4. (if (and (setq EName (entsel "\n选择多段线: ")) ; 选择对象，返回图元名+选择框位置点
   
5.          (progn
   
6.            (mapcar 'set '(EName PckPnt) EName) ; 将返回的图元名、选择框位置点赋予变量
   
7.            (or (wcmatch (cdr (assoc 0 (entget EName))) "*POLYLINE") ; 读取DXF组码，判断对象类型
   
8.                (not (princ "\n所选的对象不是多段线！")) ; 提示条件不满足，并结束命令
   
9.            )
   
10.          )
    
11.          (progn
    
12.            (setq PckPnt (trans PckPnt 1 0) ; 将选择框位置点从UCS转换为WCS
    
13.                  PckPnt (vlax-curve-getClosestPointTo EName PckPnt) ; 获取选择框位置点在多段线上的最近的(确保点的多段线上)
    
14.                  PckPnt (fix (vlax-curve-getParamAtPoint EName PckPnt)) ; 获取用户选择多段线所在段的参数
    
15.            )
    
16.            (or (equal (vlax-curve-getSecondDeriv EName PckPnt) '(0 0 0) 1E-8) ; 判断所选是否是直线段
    
17.                (not (princ "\n所选的多段线的段不能是圆弧！")) ; 提示条件不满足，并结束命令
    
18.            )
    
19.          )
    
20.          (setq Point (getpoint "\n指定构造线通过点: ")) ; 拾取构造线通过点
    
21.     )
    
22.   (progn
    
23.     (setq PckPnt2 (vlax-curve-getPointAtParam EName (1+ PckPnt)) ; 获得多段线顶点2
    
24.           PckPnt (vlax-curve-getPointAtParam EName PckPnt) ; 获取多段线段的顶点1
    
25.           Vector (mapcar '- PckPnt2 PckPnt) ; 获取两顶点的向量
    
26.           Point  (trans Point 1 Vector) ; 将拾取点从UCS转换到向量
    
27.           PckPnt (trans (vl-list* (car Point) (cadr Point) (cddr (trans PckPnt 0 Vector))) Vector 0) ; 将顶点1投影到通过拾取点的平行线上
    
28.     )
    
29.     ;; 创建构造线
    
30.     (entmake (list '(0 . "XLINE")
    
31.                    '(100 . "AcDbEntity")
    
32.                    '(100 . "AcDbXline")
    
33.                    (cons 10 PckPnt)
    
34.                    (cons 11 Vector)
    
35.               )
    
36.     )
    
37.   )
    
38. )
    
39. 
    
40. (princ)
    
41. 
    
42. )
    
43. 
    

;; 绘制多段线指定段的平行线(构造线)<br /> (defun C:TT (/ EName PckPnt Point PckPnt2 Vector)<br /> <br /> (if (and (setq EName (entsel "\n选择多段线: ")) ; 选择对象，返回图元名+选择框位置点<br />          (progn<br />            (mapcar 'set '(EName PckPnt) EName) ; 将返回的图元名、选择框位置点赋予变量<br />            (or (wcmatch (cdr (assoc 0 (entget EName))) "*POLYLINE") ; 读取DXF组码，判断对象类型<br />                (not (princ "\n所选的对象不是多段线！")) ; 提示条件不满足，并结束命令<br />            )<br />          )<br />          (progn<br />            (setq PckPnt (trans PckPnt 1 0) ; 将选择框位置点从UCS转换为WCS<br />                  PckPnt (vlax-curve-getClosestPointTo EName PckPnt) ; 获取选择框位置点在多段线上的最近的(确保点的多段线上)<br />                  PckPnt (fix (vlax-curve-getParamAtPoint EName PckPnt)) ; 获取用户选择多段线所在段的参数<br />            )<br />            (or (equal (vlax-curve-getSecondDeriv EName PckPnt) '(0 0 0) 1E-8) ; 判断所选是否是直线段<br />                (not (princ "\n所选的多段线的段不能是圆弧！")) ; 提示条件不满足，并结束命令<br />            )<br />          )<br />          (setq Point (getpoint "\n指定构造线通过点: ")) ; 拾取构造线通过点<br />     )<br />   (progn<br />     (setq PckPnt2 (vlax-curve-getPointAtParam EName (1+ PckPnt)) ; 获得多段线顶点2<br />           PckPnt (vlax-curve-getPointAtParam EName PckPnt) ; 获取多段线段的顶点1<br />           Vector (mapcar '- PckPnt2 PckPnt) ; 获取两顶点的向量<br />           Point  (trans Point 1 Vector) ; 将拾取点从UCS转换到向量<br />           PckPnt (trans (vl-list* (car Point) (cadr Point) (cddr (trans PckPnt 0 Vector))) Vector 0) ; 将顶点1投影到通过拾取点的平行线上<br />     )<br />     ;; 创建构造线<br />     (entmake (list '(0 . "XLINE")<br />                    '(100 . "AcDbEntity")<br />                    '(100 . "AcDbXline")<br />                    (cons 10 PckPnt)<br />                    (cons 11 Vector)<br />               )<br />     )<br />   )<br /> )<br /> <br /> (princ)<br /> <br /> )<br /> <br />

jzf1987

caoyin 发表于 2021-3-30 00:46

指定构造线通过点: ; 错误: 参数类型错误: numberp: (2362.37 1507.18 0.0)

jzf1987

caoyin 发表于 2021-3-30 00:46

选择多段线:
所选的多段线的段不能是圆弧！

多段线标高不为0时提示这个！

jzf1987

caoyin 发表于 2021-3-30 00:46

jzf1987

caoyin 发表于 2021-3-30 00:46

把这个判断删除貌似好了，不知有没有影响

jzf1987

caoyin 发表于 2021-3-30 00:46

           (or (equal (vlax-curve-getSecondDeriv EName PckPnt) '(0 0 0) 1E-8) ; 判断所选是否是直线段
               (not (princ "\n所选的多段线的段不能是圆弧！")) ; 提示条件不满足，并结束命令
           )


这个判断条件删除貌似好了，但是不分多段线跟圆弧都能画XLINE！