help! Masters; EXTRACT VERTEX

leo321 · 发表于 2022-7-5 16:01:56

I had this from Lee, but usually always go way counter-clockwise and only select the polyline, not the point.

;; Polyline Vertex Exporter ~ by Lee McDonnell ~ 26.11.2009
(defun c:pExp2 (/ ss tmp i j ent tot dis pt)
(vl-load-com)
(if (and (setq ss (ssget '((0 . "*POLYLINE"))))
(setq tmp (getfiled "Output File" (cond (*load) ("")) "txt;csv" 9)))
(progn
(setq *load tmp tmp (open tmp "a") i -1)
(write-line "X,Y,Layer" tmp)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq tot 0. j (1- (vlax-curve-getStartParam ent)))
(while (
(setq pt (mapcar 'rtos (vlax-curve-getPointatParam ent j)))
(write-line
(strcat (car pt) (chr 44) (cadr pt) (chr 44) (vla-get-layer (vlax-ename->vla-object ent)))
tmp))
(write-line "" tmp))
(close tmp)))
(princ))

THX for any tips.

Lee Mac · 发表于 2022-7-5 16:16:04

Wow, that's some old code...
I don't quite understand, what do you want the code to do?

PS: Please edit your post and enclose your code with code tags:

[highlight][noparse]

copy

[/noparse][/highlight]Your code here[highlight][noparse]

[/noparse][/highlight]

leo321 · 发表于 2022-7-5 16:31:18

I´ll try explian;

the file returns the polyline reverse clockwise way sample;

X,Y,Layer
485172.23,6691696.77,FC 0059
485157.93,6691697.48,FC 0059
485156.58,6691666.50,FC 0059
485171.15,6691665.78,FC 0059
485172.23,6691696.77,FC 0059

I would like th clockwise side return, (above)

485172.23,6691696.77,FC 0059
485171.15,6691665.78,FC 0059
485156.58,6691666.50,FC 0059
485157.93,6691697.48,FC 0059

If can select the FIRST vertex it will be perfect;

take this oportunite to say I follow this years, your are the guy, congrates
sorry for my bad english

Lee Mac · 发表于 2022-7-5 16:34:18

Thank you for your compliments

Please try the following:

copy

(defun c:ptx ( / *error* des ent enx lay lst txt )   (defun *error* ( msg )       (if (= 'file (type des)) (close des))       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))           (princ (strcat "\nError: " msg))       )       (princ)   )   (if (setq txt (getfiled "Create Output File" (cond ( ptx:dir ) ( "" )) "txt;csv" 1))       (while           (not               (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect 2D polyline : ")))                   (cond                       (   (= 7 (getvar 'errno))                           (prompt "\nMissed, try again.")                       )                       (   (null ent))                       (   (/= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))                           (prompt "\nThe selected object is not a 2D polyline.")                       )                       (   (not                               (or des                                   (and (setq des (open txt "w"))                                        (setq ptx:dir (strcat (vl-filename-directory txt) "\"))                                        (write-line "X,Y,Layer" des)                                   )                               )                           )                           (princ (strcat "\nUnable to open "" txt "" for writing."))                       )                       (   (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))                                 lay (list "," (strcat "," (cdr (assoc 8 enx))))                           )                           (foreach vtx (if (LM:listclockwise-p lst) lst (reverse lst))                               (write-line (apply 'strcat (mapcar 'strcat (mapcar 'rtos vtx) lay)) des)                           )                           (write-line "" des)                           (prompt (strcat "\n" (itoa (length lst)) " vertices written to " (vl-filename-base txt) (vl-filename-extension txt) "."))                       )                   )               )           )       )       (princ "\n*Cancel*")   )   (*error* nil) (princ));; List Clockwise-p - Lee Mac;; Returns T if the point list is clockwise oriented(defun LM:listclockwise-p ( lst )   (minusp       (apply '+           (mapcar               (function                   (lambda ( a b )                       (- (* (car b) (cadr a)) (* (car a) (cadr b)))                   )               )               lst (cons (last lst) lst)           )       )   ))(princ)

Lee Mac · 发表于 2022-7-5 16:46:06

And another, allowing optional selection of a start point:

copy

(defun c:ptx ( / *error* cnt des dis ent enx idx lay lst spt tmp txt )   (defun *error* ( msg )       (if (= 'file (type des)) (close des))       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))           (princ (strcat "\nError: " msg))       )       (princ)   )   (if (setq txt (getfiled "Create Output File" (cond ( ptx:dir ) ( "" )) "txt;csv" 1))       (while           (not               (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect 2D polyline : ")))                   (cond                       (   (= 7 (getvar 'errno))                           (prompt "\nMissed, try again.")                       )                       (   (null ent))                       (   (/= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))                           (prompt "\nThe selected object is not a 2D polyline.")                       )                       (   (not                               (or des                                   (and (setq des (open txt "w"))                                        (setq ptx:dir (strcat (vl-filename-directory txt) "\"))                                        (write-line "X,Y,Layer" des)                                   )                               )                           )                           (princ (strcat "\nUnable to open "" txt "" for writing."))                       )                       (   (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))                                 lst (if (LM:listclockwise-p lst) lst (reverse lst))                                 lay (list "," (strcat "," (cdr (assoc 8 enx))))                           )                           (if (setq spt (getpoint "\nSpecify start point : "))                               (progn                                   (setq idx 0                                         cnt 1                                         spt (trans spt 1 ent)                                         dis (distance spt (car lst))                                   )                                   (foreach pnt (cdr lst)                                       (if (< (setq tmp (distance spt pnt)) dis)                                           (setq dis tmp                                                 idx cnt                                           )                                       )                                       (setq cnt (1+ cnt))                                   )                                   (repeat idx (setq lst (append (cdr lst) (list (car lst)))))                               )                           )                           (foreach vtx lst                               (write-line (apply 'strcat (mapcar 'strcat (mapcar 'rtos vtx) lay)) des)                           )                           (write-line "" des)                           (prompt (strcat "\n" (itoa (length lst)) " vertices written to " (vl-filename-base txt) (vl-filename-extension txt) "."))                       )                   )               )           )       )       (princ "\n*Cancel*")   )   (*error* nil) (princ));; List Clockwise-p - Lee Mac;; Returns T if the point list is clockwise oriented(defun LM:listclockwise-p ( lst )   (minusp       (apply '+           (mapcar               (function                   (lambda ( a b )                       (- (* (car b) (cadr a)) (* (car a) (cadr b)))                   )               )               lst (cons (last lst) lst)           )       )   ))(princ)

leo321 · 发表于 2022-7-5 16:57:13

Thanks a lot, when come to Brazil your beer is guarantees, it´ll be a honor.

Lee Mac · 发表于 2022-7-5 17:11:40

..
..

[编程交流] help! Masters; EXTRACT VERTEX

发表回复

精选推荐