點選多段線生成5m或10m dtmpoint點至txt檔

ivde · 发表于 2015-10-7 16:43

hastan 发表于 2015-10-6 22:45
可以告訴我嗎

(or (tblsearch "layer" "TPTEMP")
(command "layer" "n" "TPTEMP" "")
)
(or (tblsearch "layer" "CONTEMP")
(command "layer" "n" "CONTEMP" "")
)
(or (tblsearch "layer" "DTM3D")
(command "layer" "n" "DTM3D" "")
)
(defun c:tt (/ ss dis ps box ss v pb sss m n p0 pls pts _pi2 trilst ppt ppl
ms)
(if (and (setq dis (getdist "\nDistance of Axis: "))
(setq ps (ssget "+.:S" '((0 . "*Polyline"))))
(setq pl (ssname ps 0))
(setq pls (xlrx-curve-getstretchpoints pl))
(setq ss (ssget "x" '((0 . "insert") (2 . "99"))))
(setq sss (XLRX-TriAngle ss ps nil t))
)
(progn
(setq box (list (apply 'mapcar (cons 'min pls))
(apply 'mapcar (cons 'max pls))
)
v (mapcar 'abs (apply 'mapcar (cons '- box)))
pb (mapcar '+ (list (/ dis 2) (/ dis 2) 0.) (car box))
m (fix (/ (- (car v) (/ dis 2)) dis))
n (fix (/ (- (cadr v) (/ dis 2)) dis))
p0 pb
trilst (mapcar 'xlrx-curve-getstretchpoints
(xlrx-pickset->list sss)
)
ms (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
)
(command ".layer" "F" "三角网,99" "")
(repeat m
(setq pts (cons (setq p0 (polar p0 0.0 dis)) pts))
)
(setq pts (cons pb (reverse pts))
_pi2 (/ pi 2)
ppt (apply
'append
(mapcar
'(lambda (x / p ptl)
(setq p x)
(repeat n
(setq ptl (cons (setq p (polar p _pi2 dis)) ptl))
)
(vl-remove-if
'(lambda (a) (not (XLRX-Point-IsInPoly1 a pls)))
(cons x (reverse ptl))
)
)
pts
)
)
)
(foreach x trilst
(if (setq stri
(vl-remove-if-not
(function
(lambda (a)
(apply 'xlrx-point-getTriIntersElev (cons a x))
)
)
ppt
)
);_可以再优化算法
(mapcar (function (lambda (b / pt blk)
(setq pt (apply 'xlrx-point-getTriIntersElev (cons b x))
blk (vla-insertblock
ms
(vlax-3d-point pt)
"99"
1.
1.
1.
0.
)
)
(vla-put-layer blk "TPTEMP")
(XLRX-Block-SetAtts
(entlast)
"PTELEV"
(rtos (caddr pt) 2 3)
)
(setq ppt (vl-remove b ppt))
)
)
stri
)
)
)
(if ppt
(foreach x ppt
(entmake (list '(0 . "point") (cons 10 x) '(62 . 3)))
)
)
)
)
(princ)
)

(or (tblsearch "layer" "TPTEMP") 
    (command "layer" "n" "TPTEMP" "") 
) 
(or (tblsearch "layer" "CONTEMP") 
    (command "layer" "n" "CONTEMP" "") 
) 
(or (tblsearch "layer" "DTM3D") 
    (command "layer" "n" "DTM3D" "") 
) 
(defun c:tt (/ ss dis ps box ss        v pb sss m n p0        pls pts        _pi2 trilst ppt ppl 
             ms) 
  (if (and (setq dis (getdist "\nDistance of Axis: ")) 
           (setq ps (ssget "+.:S" '((0 . "*Polyline")))) 
           (setq pl (ssname ps 0)) 
           (setq pls (xlrx-curve-getstretchpoints pl)) 
           (setq ss (ssget "x" '((0 . "insert") (2 . "99")))) 
           (setq sss (XLRX-TriAngle ss ps nil t)) 
      ) 
    (progn 
      (setq box           (list (apply 'mapcar (cons 'min pls)) 
                         (apply 'mapcar (cons 'max pls)) 
                   ) 
            v           (mapcar 'abs (apply 'mapcar (cons '- box))) 
            pb           (mapcar '+ (list (/ dis 2) (/ dis 2) 0.) (car box)) 
            m           (fix (/ (- (car v) (/ dis 2)) dis)) 
            n           (fix (/ (- (cadr v) (/ dis 2)) dis)) 
            p0           pb 
            trilst (mapcar 'xlrx-curve-getstretchpoints 
                           (xlrx-pickset->list sss) 
                   ) 
            ms           (vla-get-modelspace 
                     (vla-get-activedocument (vlax-get-acad-object)) 
                   ) 
      ) 
      (command ".layer" "F" "三角网,99" "") 
      (repeat m 
        (setq pts (cons (setq p0 (polar p0 0.0 dis)) pts)) 
      ) 
      (setq pts         (cons pb (reverse pts)) 
            _pi2 (/ pi 2) 
            ppt         (apply 
                   'append 
                   (mapcar 
                     '(lambda (x / p ptl) 
                        (setq p x) 
                        (repeat        n 
                          (setq ptl (cons (setq p (polar p _pi2 dis)) ptl)) 
                        ) 
                        (vl-remove-if 
                          '(lambda (a) (not (XLRX-Point-IsInPoly1 a pls))) 
                          (cons x (reverse ptl)) 
                        ) 
                      ) 
                     pts 
                   ) 
                 ) 
      ) 
      (foreach x trilst 
        (if (setq stri 
                   (vl-remove-if-not 
                     (function 
                       (lambda (a) 
                         (apply 'xlrx-point-getTriIntersElev (cons a x)) 
                       ) 
                     ) 
                     ppt 
                   ) 
            );_可以再优化算法 
          (mapcar (function (lambda (b / pt blk) 
                              (setq pt        (apply 'xlrx-point-getTriIntersElev (cons b x)) 
                                    blk        (vla-insertblock 
                                          ms 
                                          (vlax-3d-point pt) 
                                          "99" 
                                          1. 
                                          1. 
                                          1. 
                                          0. 
                                        ) 
                              ) 
                              (vla-put-layer blk "TPTEMP") 
                              (XLRX-Block-SetAtts 
                                (entlast) 
                                "PTELEV" 
                                (rtos (caddr pt) 2 3) 
                              ) 
                              (setq ppt (vl-remove b ppt)) 
                            )   
                  ) 
                  stri 
          ) 
        ) 
      ) 
      (if ppt 
        (foreach x ppt 
          (entmake (list '(0 . "point") (cons 10 x) '(62 . 3)))   
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

hastan · 发表于 2015-10-7 18:54

提示: 作者被禁止或删除内容自动屏蔽

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

hastan hastan 当前离线积分 1925 明经币个注册时间 2014-12-26 在线时间小时威望金钱个贡献激情	楼主\| 发表于 2015-10-7 18:54 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡

[提问] 點選多段線生成5m或10m dtmpoint點至txt檔