返回二次三次拟合线控制点坐标

树櫴希德

返回二次三次拟合线控制点坐标

1. (defun vxs ( ent / PLTYPE obj vtx vtxlst n ptlst)  ;提取多段线顶点坐标
   
2.     (vl-load-com)
   
3.    ; (setq ent (entsel "\n选取多线:\n"))
   
4.     (if ent
   
5.         (progn
   
6.           (setq PLTYPE (cdr (assoc 0 (entget (car ent)))))
   
7.           (if (or (= "POLYLINE" PLTYPE) (= "LWPOLYLINE" PLTYPE))
   
8.               (progn
   
9.                  (setq obj (vlax-ename->vla-object (car ent)))
   
10.                  (setq vtx (vla-get-Coordinates obj))
    
11.                  (setq vtxlst (vlax-safearray->list (vlax-variant-value vtx)))
    
12.                  (setq n 0)
    
13.                  (setq ptlst nil)
    
14.                  (repeat (/ (length vtxlst) 3)
    
15.                          (setq ptlst (append ptlst (list (list (nth n vtxlst) (nth (1+ n) vtxlst)(nth (+ n 2) vtxlst)   ))))
    
16.                          (setq n (+ n 3))
    
17.                  )
    
18.                  (if ptlst ptlst nil)
    
19.              )
    
20.              (prompt "\n选取实体不是多义线!")
    
21.           );if
    
22.        )      
    
23.      )
    
24.    ;if
    
25.    ptlst
    
26.   );;;;;;;-------------------
    
27. (setq e (entsel "\n选择多段线:"))
    
28. 
    
29. 
    
30. (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length (vxs e  ))))
    
31.       (mapcar '(lambda (pt)(cons 10 pt)) (vxs e  ) ))
    
32.   )
    
33. 
    
34. ;;;(vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object (car (entsel))))))

(defun vxs ( ent / PLTYPE obj vtx vtxlst n ptlst)  ;提取多段线顶点坐标<br />     (vl-load-com)<br />    ; (setq ent (entsel "\n选取多线:\n"))<br />     (if ent<br />         (progn<br />           (setq PLTYPE (cdr (assoc 0 (entget (car ent)))))<br />           (if (or (= "POLYLINE" PLTYPE) (= "LWPOLYLINE" PLTYPE))<br />               (progn<br />                  (setq obj (vlax-ename->vla-object (car ent)))<br />                  (setq vtx (vla-get-Coordinates obj))<br />                  (setq vtxlst (vlax-safearray->list (vlax-variant-value vtx)))<br />                  (setq n 0)<br />                  (setq ptlst nil)<br />                  (repeat (/ (length vtxlst) 3)<br />                          (setq ptlst (append ptlst (list (list (nth n vtxlst) (nth (1+ n) vtxlst)(nth (+ n 2) vtxlst)   ))))<br />                          (setq n (+ n 3))<br />                  )<br />                  (if ptlst ptlst nil)<br />              )<br />              (prompt "\n选取实体不是多义线!")<br />           );if<br />        )       <br />      )<br />    ;if<br />    ptlst<br />   );;;;;;;-------------------<br /> (setq e (entsel "\n选择多段线:"))<br /> <br /> <br /> (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length (vxs e  ))))<br />       (mapcar '(lambda (pt)(cons 10 pt)) (vxs e  ) ))<br />   )<br /> <br /> ;;;(vlax-safearray->list (vlax-variant-value (vla-get-Coordinates (vlax-ename->vla-object (car (entsel))))))

树櫴希德

1. 命令: (VL-LOAD-COM)
   
2. 
   
3. 命令: (vlax-safearray->list (vlax-variant-value (vlax-get-property
   
4. (vlax-ename->vla-object  (car(entsel)) ) 'Coordinates) ))
   
5. 选择对象: (1258.43 660.372 0.0 1719.35 558.429 0.0 2087.03 1041.78 0.0)
   

命令: (VL-LOAD-COM)<br /> <br /> 命令: (vlax-safearray->list (vlax-variant-value (vlax-get-property <br /> (vlax-ename->vla-object  (car(entsel)) ) 'Coordinates) ))<br /> 选择对象: (1258.43 660.372 0.0 1719.35 558.429 0.0 2087.03 1041.78 0.0)<br />

树櫴希德

树櫴希德 发表于 2023-6-22 19:34

1. (setq en1 (car(entsel "\n please select lwpoliline")) )
   
2. (setq en (entget en1 '("*") ))
   
3. 
   
4. (setq  en (vl-remove-if '(LAMBDA (x) (= (car x) 10))  en ))
   
5. 
   
6. (setq en (subst '(0 . "POLYLINE") '(0 . "LWPOLYLINE") en))
   
7. (setq en (subst '(100 . "AcDb2dPolyline") '(100 . "AcDbPolyline") en))
   
8. (setq en (append en (list '(66 . 1))))  (setq en (append en (list '(10 0.0 0.0 0.0))))
   
9. 
   
10. (setq en (append en (list '(71 . 0))))
    
11. (setq en (append en (list '(72 . 0))))
    
12. (setq en (append en (list '(73 . 0))))
    
13. (setq en (append en (list '(74 . 0))))
    
14. (setq en (append en (list '(75 . 0))))
    
15. 
    
16. (entmod en )
    
17. (vlax-ename->vla-object  (car(entsel)) )
    
18. 
    
19. (entget(car(entsel))'("*"))

(setq en1 (car(entsel "\n please select lwpoliline")) )<br /> (setq en (entget en1 '("*") ))<br /> <br /> (setq  en (vl-remove-if '(LAMBDA (x) (= (car x) 10))  en ))<br /> <br /> (setq en (subst '(0 . "POLYLINE") '(0 . "LWPOLYLINE") en))<br /> (setq en (subst '(100 . "AcDb2dPolyline") '(100 . "AcDbPolyline") en))<br /> (setq en (append en (list '(66 . 1))))  (setq en (append en (list '(10 0.0 0.0 0.0))))<br /> <br /> (setq en (append en (list '(71 . 0))))<br /> (setq en (append en (list '(72 . 0))))<br /> (setq en (append en (list '(73 . 0))))<br /> (setq en (append en (list '(74 . 0))))<br /> (setq en (append en (list '(75 . 0))))<br /> <br /> (entmod en ) <br /> (vlax-ename->vla-object  (car(entsel)) )<br /> <br /> (entget(car(entsel))'("*"))

依然小小鸟

不错的帖子 顶一下

小鸟

标记 备用 会用到

树櫴希德

树櫴希德 发表于 2023-6-22 19:34

1. (vl-load-com)
   
2. ;(vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object  (car(entsel)) ) 'Coordinates) ))
   
3. (defun vxs (e /   )
   
4. (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object  e ) 'Coordinates) ))
   
5. ;;;;;;;;;;;;;;;
   
6. )
   
7.   (defun c:tt11 ( / lst ent pts pt demj zmj ffn ff i) ;生成CASS三角网文件SJW
   
8. 
   
9.   (setq lst (ssget '( (0 . "*polyline,3dface") (8 . "SW-自然地表模型")) ) )
   
10. (setq i 0)
    
11. 
    
12. (setq ffn (getfiled "选取/建立数据导出文件" "" "sjw" 1))
    
13.   (setq ff (open ffn "w"))
    
14. 
    
15.   
    
16. (while  (< i (sslength lst))
    
17. 
    
18. (setq ent (ssname lst i))
    
19. (setq pts (vxs ent)); 3DFACE本来应该去除第四点，但本程序未去除
    
20. 
    
21.   (foreach x pts
    
22. (princ  (strcat (rtos x 2 3) "\n" ) ff)
    
23.     )
    
24. 
    
25.   
    
26. 
    
27. (setq i (+ i 1))
    
28.   )
    
29. (close ff)
    
30.   (princ)
    
31. 
    
32. 
    
33.     )

(vl-load-com)<br /> ;(vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object  (car(entsel)) ) 'Coordinates) ))<br /> (defun vxs (e /   )<br /> (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object  e ) 'Coordinates) ))<br /> ;;;;;;;;;;;;;;;<br /> )<br />   (defun c:tt11 ( / lst ent pts pt demj zmj ffn ff i) ;<font size="6">生成CASS三角网文件SJW<br /> </font><br />   (setq lst (ssget '( (0 . "*polyline,3dface") (8 . "SW-自然地表模型")) ) )<br /> (setq i 0)<br /> <br /> (setq ffn (getfiled "选取/建立数据导出文件" "" "sjw" 1))<br />   (setq ff (open ffn "w"))<br /> <br />   <br /> (while  (< i (sslength lst))<br /> <br /> (setq ent (ssname lst i))<br /> (setq pts (vxs ent)); 3DFACE本来应该去除第四点，但本程序未去除<br /> <br />   (foreach x pts<br /> (princ  (strcat (rtos x 2 3) "\n" ) ff)<br />     )<br /> <br />   <br /> <br /> (setq i (+ i 1))<br />   )<br /> (close ff)<br />   (princ)<br /> <br /> <br />     )

寒潮大冬瓜

朴大侠的“二次三次拟合线控制点坐标”经过优化→辛苦把优化后的文件文件发上来好吧？