labelling Easting & Northing c

Lee Mac · 发表于 2022-7-6 06:46:48

This will return points in WCS:

(defun c:pt ( / p )   (while (setq p (getpoint "\nPick point to label: "))       (entmake           (list              '(000 . "MTEXT")              '(100 . "AcDbEntity")              '(100 . "AcDbMText")               (cons 011 (getvar 'ucsxdir))               (cons 010 (setq p (trans p 1 0)))               (cons 001 (apply 'strcat (mapcar 'strcat '("E " "\\PN " "\\PZ ") (mapcar 'rtos p))))               (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))           )       )   )   (princ))

This will returns points in UCS:

copy

(defun c:pt ( / p )   (while (setq p (getpoint "\nPick point to label: "))       (entmake           (list              '(000 . "MTEXT")              '(100 . "AcDbEntity")              '(100 . "AcDbMText")               (cons 011 (getvar 'ucsxdir))               (cons 010 (trans p 1 0))               (cons 001 (apply 'strcat (mapcar 'strcat '("E " "\\PN " "\\PZ ") (mapcar 'rtos p))))               (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))           )       )   )   (princ))

Tharwat · 发表于 2022-7-6 06:48:22

Lee , I can't see the difference between the two routines , but i think the second one - the trans function must be 0 1 and not 1 0 , Am I right ?

kallerman · 发表于 2022-7-6 06:51:51

well.......... i created a new UCS, then i entered a line from origin (0,0) to point(4400', 3000') ,,, then i moved the whole layout from left bottom corner (4400, 3000) to that point
amd now it gives the correct coordinates,....BUT ALL IN INCHES,.... again a problem,....

kallerman · 发表于 2022-7-6 06:55:35

58000.53" / 12 = 4833.37' ,...... it means its giving correct coordinates,.... but i need them in feet,
plz help

Lee Mac · 发表于 2022-7-6 06:59:07

No, look closer.

CheSyn · 发表于 2022-7-6 07:00:16

I was unaware you were intending to alter the origin, as it was not specified in your original request. I will look into writing something if I have some free time on my vacation. If not, there are many knowledgeable members who can assist you.

Edit: disregard, I was too slow posting.

kallerman · 发表于 2022-7-6 07:04:53

im thankful to you guys,...

my current problem is y the coordinates are in INCHES,.... ? THEY MUST BE IN FEET,.........
KINDLY GIVE SOLUTION,.....

HERE IS THE CODE IM USING:

copy

(defun Styles()         ;create text Style            (if (not (tblsearch "style" "Gen-Text")) (command "-style" "Gen-Text" "Arial.ttf" "A""yes" "No" 2.5 "1" 0 "n" "n"))      ;create dimension style      (if (not (tblsearch "DImstyle" "Dim Arrow Ann"))       (progn          (command "dim" "style" "Gen-Text"           "DIMADEC"     0           "DIMALT"      0           "DIMALTD"     2           "DIMALTF"     1.000           "DIMALTRND"   0.0000           "DIMALTTD"    2           "DIMALTTZ"    0           "DIMALTU"     2           "DIMALTZ"     0           "DIMASZ"      3           "DIMATFIT"    3           "DIMAUNIT"    0           "DIMAZIN"     0           "DIMBLK"      ""           "DIMBLK1"     ""           "DIMBLK2"     ""           "DIMLDRBLK"   ""           "DIMCEN"      0           "DIMCLRD"     7           "DIMCLRE"     7           "DIMCLRT"     7           "DIMDEC"      0           "DIMDLE"      0.0000           "DIMDLI"      1.0000           "DIMEXE"      1.5000           "DIMEXO"      1.5000           "DIMFRAC"     0           "DIMGAP"      1.0000           "DIMJUST"     0           "DIMLFAC"     1000.0000           "DIMLIM"      0           "DIMLUNIT"    2           "DIMLWD"      0           "DIMLWE"      0            "DIMRND"      0.0000           "DIMSAH"      0           "DIMSCALE"    1.0000           "DIMSD1"      0           "DIMSD2"      0           "DIMSE1"      0           "DIMSE2"      0           "DIMSOXD"     0           "DIMTAD"      1                "DIMTDEC"     0           "DIMTIH"      0           "DIMTIX"      0           "DIMTM"       0.0000           "DIMTMOVE"    0           "DIMTOFL"     0           "DIMTOH"      0           "DIMTSZ"      0.0000           "DIMTVP"      0.0000           "DIMTXSTY"    "Gen-Text"           "DIMTXT"      2.5000           "DIMZIN"      0           "DIMFIT"      5 /e)                          (command "dimstyle" "An" "y" "Dim Arrow Ann" "S" "")       ) ;progn     ) ;if     ) ;defun;;-------------------------------------------* error *-----------------------------------------------------(defun trap1 (errmsg)          (setq *error* temperr)          (setvar "clayer" clay)          (prompt "\n © Bijoy manoharan 2010 www.cadlispandtips.com")(princ)) ;defun;;-------------------------------------------Set Datum-----------------------------------------------------(defun C:dat (/ num op sta pga stb pgb)             (command "cmdecho"0)       (command "ucs" "w")          ;;; input station              (if (not nf-ns) (setq nf-ns 0.000))    ; default number       (setq NUM (getreal (strcat "\nEnter Eastward datum : ")))         (if (not num) (setq num nf-ns) (setq nf-ns num))  ;;; input pgl       (if (not sf-ss) (setq sf-ss 0.000))    ; default number       (setq SUM (getreal (strcat "\nEnter Northward datum : ")))        (if (not sum) (setq sum sf-ss) (setq sf-ss sum))     ;;; set orign point       (setq op (getpoint "\nPick datum orgin point: "))         (setq sta (car op))       (setq pga (cadr op))          (setq stb (- sta num))              (setq pgb (- pga sum))           (command "ucs" "m" (list stb pgb 0))       (prompt "\nOrigin moved to new loaction - Enter Command EN to place Text")               (princ)) ;defun       ;;-------------------------------------------Place Text----------------------------------------------------(defun C:EN (/ enp1 ex ey dy ptl e TextObj vlText)        (command "cmdecho"0)        (setq clay (getvar "clayer"))        (setq temperr *error*)        (setq *error* trap1)                              (if (not (tblsearch "layer" "Text Coordinate")) (command  "-LAYER" "N" "Text Coordinate" "C" "7" "Text Coordinate" "LT"  "Continuous" "Text Coordinate""LW" "0.15" "Text Coordinate" ""))        (Styles)        (command "CLAYER" "Text Coordinate")        (command "-DIMSTYLE" "r" "Dim Arrow Ann")                (setq ptlist nil) ; for while command (while         (progn                  (setq enp1 (getpoint "\nPick Coordinate point: "))         (setq ex (car enp1))  ;x coord         (setq ey (cadr enp1)) ;y coord         (setq enx (rtos ex 2 3))         (setq eny (rtos ey 2 3))                      (setq ptl (getpoint "\nPick text location: "))                (SETVAR 'DIMTAD 0) ; Justification centered         (SETVAR 'DIMLDRBLK "_ORIGIN") ;; leader arrow       (command "leader" enp1 ptl "" (strcat "E " enx) (strcat "N " eny) "")       (setq TextObj (entlast))            (vl-load-com)       (setq vlText (vlax-ename->vla-object TextObj))            (vlax-put-property vlText 'backgroundfill :vlax-true)  ; background mask               (SETVAR 'DIMTAD 1 ) ; Justification above        (setvar "DIMLDRBLK" ".") ;;leader arrow        (setq ptlist (append ptlist (list pt))) ; to stop while command      ) ;progn    ) ;while    (princ)) ; defun             ;;----------------------------------------Back to UCS World-----------------------------------------------------(defun C:uw ()       (command "ucs" "w")       (prompt "\nUCS Origin is set to World") (princ)) ; defun(princ "\nEasting & Northing Lisp | © Bijoy manoharan 2010 | [url="http://www.cadlispandtips.com"]www.cadlispandtips.com[/url] |")(princ "\nLisp Commands:DAT(to set Datum point),UW(Ucs World),EN(to Coordinate text)")(princ);;----------------------------------------------End-----------------------------------------------------

eldon · 发表于 2022-7-6 07:08:51

The short answer is that your new drawing is not in the correct drawing units, and should probably be scaled to suit.

If you want to adjust your existing lisp, then look at the "rtos" function which needs the correct mode to do what you want. But if you alter the lisp for this drawing, then will all the rest of your drawings misbehave?

P.S. you should probably edit your previous post to enclose the lisp code in code quotes otherwise the Mods will be getting at you

SLW210 · 发表于 2022-7-6 07:11:33

Please read the Code posting guidelines and edit your post to include the Code in Code Tags.

eea123 · 发表于 2022-7-6 07:15:01

Call me old school, but as a civil engineer I still work "unitless". I would have approached a drawing like this two fold. Assuming I received it from a client (presumably an architect), I would have started a new base civil drawing in decimal feet and XREF'd the drawing in at 1/12 and moved and rotated the XREF to a new origin (if necessary).

I also do this with my many of my own drawings (sans the 1/12 scaling) since we start survey projects in an assumed coordinate system; ie N=10,0000 E=5,000 Elev=100 and then post process the local control onto State Plane Coordinates and reference onto our GIS mapping.

[编程交流] labelling Easting & Northing c

发表回复

精选推荐