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

Co-ordinates using fields in t

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?
 

(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:
 

(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))
页: [1] 2
查看完整版本: Co-ordinates using fields in t