Co-ordinates using fields in t

Emily_83 · 发表于 2022-7-6 11:17:41

Hi Lee, (and everyone else)

hopefully i can explain enough of what i am after.

what i need is a .lsp routine that when i select a polyline in Cad it will place the points in a table with the point number and Easting and Northing, i do not need the Radius, just the 3 colums Point, Easting and Northing, i would love it if it could also number the points on the polyline to the points in the table.
what i am also after is for the table to have fields so that when i move the point the Easting and Northing updates Automatically.
hoping i have made sense, and sorry for the huge request
any help would be greatly appreciated

Emily

Lee Mac · 发表于 2022-7-6 11:26:54

Hi Emily,

I'm not sure this is possible using Fields with the Polyline object - as fields do not account for this property.

It does have workarounds however - for example, you could have a point at every polyline vertex and use the point position in the field - but this is less than desirable.

Alternatively this could be done through the use of reactors - but it would be a complex program indeed to couple that many items effectively.

Lee

Emily_83 · 发表于 2022-7-6 11:30:19

Ohh boo, thought i was pushing my luck....hahaha :-)

thankyou very mcuh for the info Lee,

for the workaround that would be very useful to me as i am working with points and my Colleague is working with the Polyline, so i was trying to get him a routine for the PLine.
is there a lsp routine available for the points one??

PS_Port · 发表于 2022-7-6 11:34:27

Some of these might help.

http://www.theswamp.org/index.php?topic=13003.0

http://www.theswamp.org/index.php?topic=11380.0

Emily_83 · 发表于 2022-7-6 11:41:12

thanks for the links PS_Port,

i will go take a look now

Lee Mac · 发表于 2022-7-6 11:42:54

Hows this?

copy

(defun c:pt2fld (/ *error* COL ENT I LST OBJLST PT ROW SPC SS STR TSS UFLAG) (vl-load-com) ;; Lee Mac  ~  09.02.10 (defun *error* (msg)   (and uFlag (vla-EndUndoMark *doc))   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")       (princ (strcat "\n** Error: " msg " **")))   (princ)) (setq *doc (cond (*doc) ((vla-get-ActiveDocument                            (vlax-get-acad-object))))) (setq spc  (if (zerop (vla-get-ActiveSpace *doc))              (vla-get-PaperSpace *doc)              (vla-get-ModelSpace *doc))) (if (setq i -1 tss (ssget "_X" '((0 . "ACAD_TABLE"))))   (while (setq ent (ssname tss (setq i (1+ i))))     (setq ObjLst       (cons         (vlax-ename->vla-object ent) ObjLst)))) (if (setq i -1 ss (ssget '((0 . "POINT"))))   (while (and (setq ent (ssname ss (setq i (1+ i))))               (setq pt  (getpoint "\nSelect Point for Field: ")))     (setq uFlag (not (vla-StartUndoMark *doc)))     (setq Str (strcat "%%).Coordinates \\f "%lu2%pr2">%"))     (cond (  (setq lst                (car                  (vl-remove-if (function null)                    (mapcar                      (function                        (lambda (table)                          (if (eq :vlax-true                                (vla-HitTest table                                  (vlax-3D-point (trans pt 1 0))                                    (vlax-3D-point                                      (trans (getvar 'VIEWDIR) 1 0)) 'row 'col))                                                        (list table row col)))) ObjLst))))                (apply (function vla-SetText)                       (append lst (list Str))))           (t  (vla-AddMText spc                 (vlax-3D-point pt) 0. str)))     (setq uFlag (vla-EndUndoMark *doc))))  (vla-regen *doc acActiveViewport) (princ))

Emily_83 · 发表于 2022-7-6 11:51:06

Lee that is brilliant, :-)
a few requests if possible though,
the routine says select objects which i do, but does not automatically place the text next to points, i have to remember in which order i selected the text.
is it possible to modify the text to make this happen??
also now once i have that done, is there a way to quickly get those Co-ords into a table(besides EATTEXT command),
thankyou so much for your time and help,

Lee Mac · 发表于 2022-7-6 11:55:05

Yeah, currently the user can click in a table cell to put it there - but I wasn't sure about what the table format should be? Just one column of points?

Emily_83 · 发表于 2022-7-6 12:02:26

if possible

i am after 3 Columns.

POINT, EASTING and NORTHING

Lee Mac · 发表于 2022-7-6 12:03:30

Hi Emily,

Try this:

copy

(defun c:pt2fld (/ *error* ENT I J LLST OBJ PT SPC SS STRLST TBLOBJ UFLAG) (vl-load-com) ;; Lee Mac  ~  09.02.10 (defun *error* (msg)   (and uFlag (vla-EndUndoMark *doc))   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")       (princ (strcat "\n** Error: " msg " **")))   (princ)) (setq *doc (cond (*doc) ((vla-get-ActiveDocument                            (vlax-get-acad-object))))) (setq spc  (if (zerop (vla-get-ActiveSpace *doc))              (vla-get-PaperSpace *doc)              (vla-get-ModelSpace *doc))) (if (and (setq i -1 ss (ssget '((0 . "POINT"))))          (setq pt (getpoint "\nPoint for Table: ")))   (progn     (setq uFlag (not (vla-StartUndoMark *doc)))     (while (setq ent (ssname ss (setq i (1+ i))))       (setq StrLst (cons                      (list (itoa (1+ i))                            (strcat "%%).Coordinates \\f "%lu2%pt1%pr2">%")                                                      (strcat "%%")) StrLst))       (setq lLst (append (mapcar                            (function                              (lambda (x) (strlen (rtos x 2 2))))                                                        (cdr (assoc 10 (entget ent)))) lLst))              (vla-put-Alignment         (setq tObj                    (vla-AddText spc (itoa (1+ i))             (vla-get-Coordinates obj) (getvar 'TEXTSIZE))) acAlignmentMiddleCenter)       (vla-put-TextAlignmentPoint tObj (vla-get-Coordinates obj)))     (setq tblObj       (vla-AddTable spc (vlax-3D-point pt)         (+ 2 (length StrLst)) 3           (* 1.2 (getvar 'TEXTSIZE))           (* (apply (function max) (append '( lLst)) 1.5 (getvar 'TEXTSIZE))))     (vla-SetText tblObj 0 0 "Emily's Points :-)")     (setq i 1 j -1)     (mapcar       (function         (lambda (x)           (vla-SetText tblObj i (setq j (1+ j)) x)))       '("POINT" "EASTING" "NORTHING"))     (setq j 0)     (mapcar       (function         (lambda (x)           (setq i (1+ i) j -1)           (mapcar             (function               (lambda (y)                 (vla-SetText tblObj i (setq j (1+ j)) y))) x)))       (reverse StrLst))     (setq uFlag (vla-EndUndoMark *doc)))) (princ))

[编程交流] Co-ordinates using fields in t

发表回复

精选推荐