Author Topic: help with coordinate table with area  (Read 840 times)

0 Members and 1 Guest are viewing this topic.

HOSNEYALAA

  • Newt
  • Posts: 53
Re: help with coordinate table with area
« Reply #15 on: September 07, 2020, 04:25:37 PM »
hi test this


Code: [Select]

;;;https://www.theswamp.org/index.php?topic=56230.0


(defun rh:yn (msg default / tmp) (initget 6 "Yes No") (cond ( (getkword (strcat msg " [Yes/No] < " default " > : "))) (default)))

(defun rh:pchk (vlst pt fz / tmp) (while (not (equal pt (car vlst) fz)) (setq tmp (car vlst) vlst (append (cdr vlst) (list tmp)))))

(defun rh:pcw-p ( obj / tmp flg)
  (if (= (type obj) 'ENAME) (setq obj (vlax-ename->vla-object obj)))
  (cond ( (vlax-method-applicable-p obj 'offset)
          (setq tmp (car (vlax-invoke obj 'offset -0.005))
                flg (if (> (vlax-get tmp 'area) (vlax-get obj 'area)) T nil)
          );end_setq
          (vla-delete tmp)
          flg
        )
        (t "")
  );end_cond
);end_defun

(vl-load-com)

;;Polyline Area Table
(defun C:PAT ( / *error* sv_lst sv_vals c_doc c_spc acc iunits dut aut ccf acf fuzz flg ent pt obj cw ss cnt ent nme vlst bent tlst)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );end_local_*error*_defun

  (setq sv_lst (list 'cmdecho 'osmode 'dynprompt 'dynmode)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        acc (getvar 'luprec)
  );end_setq

  (cond ( (= (setq iunits (getvar 'insunits)) 6) (setq dut "m" aut (strcat "sq." dut) ccf 1.0 acf 1.0 fuzz 0.001)); CHANGE so dut=distance & aut=Area
        ( (= iunits 4)
          (setq dut "mm" aut (strcat "sq." dut) ccf 1.0 acf 1.0 fuzz 1.0); CHANGE dut & aut
          (if (= (rh:yn "\nInsertion Units are Millimetres. Convert Areas & Coordinates to Metres : ?" "No") "Yes")
            (setq dut "m" aut (strcat "sq." dut) ccf 1000.0 acf 1.0e6); CHANGE dut & aut
          );end_if
        )
        (t (setq iunits nil ccf 1.0 acf 1.0 fuzz 1.0))
  );end_cond

  (mapcar 'setvar sv_lst '( 0 1 3 1))

  (while (not flg)
    (setq ent (car (entsel "\nSelect Closed LWPolyline : "))
          obj (vlax-ename->vla-object ent)
    );end_setq

    (cond ( (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
            (setq pt (reverse (cdr (reverse (getpoint "\nSelect Start Point : "))))
                  vlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))
            );end_setq
            (cond ( (equal (car vlst) (last vlst) fuzz)
                    (setq vlst (reverse (cdr (reverse vlst))))
                    (if (= :vlax-false (vlax-get-property obj 'closed)) (vlax-put-property obj 'closed :vlax-true))
                    (setq flg T cw (rh:pcw-p ent))
                  )
                  ( (= :vlax-true (vlax-get-property obj 'closed)) (setq flg T cw (rh:pcw-p ent)))
                  (t (alert "NOT a CLOSED LWPolyline"))
            )
            (if (not cw) (setq vlst (reverse vlst)))
          )
          (t (alert "NOT a LWPolyline"))
    );end_cond
  );end_while

  (setvar 'osmode 0)
  (setq vlst (rh:pchk vlst pt fuzz))

   
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq blksObj (vla-get-blocks doc))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (setq spc (vla-get-modelspace doc))

 
  (cond (flg
          (setq nme (strcase (getstring "\nEnter Area Name : "))
                tlst (cons (list (strcat "E{\\H0.8x;" nme "} = " (rtos (/ (vlax-curve-getarea ent) acf) 2 2) " " aut)) tlst)
                tlst (cons (list "E=1/2 S(Xi + Xi+1)(Yi - Yi+1)") tlst)
                ss (ssget "F" vlst '((0 . "INSERT") (66 . 1)))
          );end_setq
          (repeat (setq cnt (sslength ss))
            (setq bent (ssname ss (setq cnt (1- cnt))));;; ("34" "161.028" "199.985")
   
    (setq atts (vlax-invoke
                     (setq blk (vlax-ename->vla-object bent))
                     'getattributes
                   )
        )

    (foreach att atts
;;;       (setq att (CAR atts))
              (cond
                    (
     (eq (vla-get-tagstring att) "POINT")
                     (setq elev (vla-get-textstring att))
                     
                    )
                   
              )
            )
(setq pt (vlax-get blk 'insertionpoint))
   
                 (setq tlst (cons (list elev
                                   (rtos (car pt) 2 acc)
                                   (rtos (cadr pt) 2 acc)
                             )
                             tlst
                       )
            );end_setq
          );end_repeat
          (setq tlst (cons (list "A/A" (strcat "X" (if iunits (strcat " (" dut ")") " (?)")) (strcat "Y" (if iunits (strcat " (" dut ")") " (?)"))) tlst)); CHANGE column headers
          (rh:AMT c_spc (strcat "TABLE " nme) tlst)
        )
        (t (alert "No Polyline Selected"))
  );end_cond

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

    (defun rh:AMT ( spc title lst / ipt t_obj rows cols row cell rdat)

  (setq ipt (getpoint "\nSelect Table Insertion Point: ")
        t_obj (vla-addtable spc (vlax-3d-point ipt) (1+ (length lst)) (length (car lst)) 5.0 22.5)
  );end_setq

  (vla-put-regeneratetablesuppressed t_obj :vlax-true)

  (mapcar '(lambda (x y) (vlax-put-property t_obj x y)) (list 'horzcellmargin 'vertcellmargin 'rowheight) (list 0.5 0.5 5.0))
  (vla-settextstyle t_obj (+ acDataRow acHeaderRow acTitleRow) "TOPOCAD")

  ; Title row
  (vlax-invoke t_obj 'setrowheight 0 10.0)
  (vlax-invoke t_obj 'setcelltextheight 0 0 2.5)
  (vlax-invoke t_obj 'settext 0 0 title)

  (setq rows (- (vlax-get t_obj 'rows) 2)
        cols (1- (vlax-get t_obj 'columns))
        row 1
        cell 0
  );end_setq

  ; loop through data cells
  (while (< row rows)
    (setq rdat (nth (- row 1) lst))
    (while (<= cell cols)
      (vlax-invoke t_obj 'setcelltextheight row cell 2.5)
      (vlax-invoke t_obj 'settext row cell (nth cell rdat))
      (vlax-invoke t_obj 'setcellalignment row cell acMiddleCenter)
      (setq cell (1+ cell))
    );end_while
    (setq row (1+ row) cell 0)
  );end_while
  (repeat 2
    (vlax-invoke t_obj 'setrowheight row 6.0)
    (vlax-invoke t_obj 'mergecells row row 0 cols)
    (setq rdat (nth (1- row) lst))
    (vlax-invoke t_obj 'setcelltextheight row 0 2.5)
    (vlax-invoke t_obj 'settext row 0 (car rdat))
    (setq row (1+ row))
  );end_repeat
  (vla-put-regeneratetablesuppressed t_obj :vlax-false)
);end_defun


Dlanor

  • Bull Frog
  • Posts: 260
Re: help with coordinate table with area
« Reply #16 on: September 07, 2020, 06:18:05 PM »
I got this error isInside AutoCad.exe
Code: [Select]
Select Closed LWPolyline :
Select Start Point :
Enter Area Name : "https://sdaromania.clickmeeting.com/394199842/ended"
An Error : no function definition: GETPROPERTYVALUE occurred.
Command:
Automatic save to
"Automatic Tester for Software"
I try fill the table with web-link adresses. :sleezy:
(snapshot.gif "cl_aclayer_enttable_2020_pp_tablegreece-vlax.gif")

What version of AutoCAD are you using? The GET/SETPROPERTYVALUE and DUMPALLPROPERTIES weren't implimented until 2012. If you have a later version you may have another problem.  :thinking: 


BIGAL

  • Swamp Rat
  • Posts: 516
  • 30 + years of using Autocad
Re: help with coordinate table with area
« Reply #17 on: September 07, 2020, 08:48:01 PM »
Bricscad does not support get set property also.
A man who never made a mistake never made anything

PM

  • Newt
  • Posts: 127
Re: help with coordinate table with area
« Reply #18 on: September 11, 2020, 01:58:16 AM »
Hi Dlanor . I test a lot this code and i see that export to a table the coordinates of all block are near or even touch a polyline. I want to export only the blocks are on vertices of the polyline, because when i have a lot of points become chaos. Look the test.dwg . Is a simple example

Thanks

Dlanor

  • Bull Frog
  • Posts: 260
Re: help with coordinate table with area
« Reply #19 on: September 11, 2020, 02:49:25 AM »
Not much I can do at the moment, I won't have time to look at it until late afternoon. I know what the solution is but no time to code it.

BIGAL

  • Swamp Rat
  • Posts: 516
  • 30 + years of using Autocad
Re: help with coordinate table with area
« Reply #20 on: September 11, 2020, 03:22:24 AM »
Maybe this simple test

Code: [Select]
(setq pt (getpoint))
(setq ss (ssget pt (list (cons 0 "insert"))))
(entget (ssname ss 0))
A man who never made a mistake never made anything

BIGAL

  • Swamp Rat
  • Posts: 516
  • 30 + years of using Autocad
Re: help with coordinate table with area
« Reply #21 on: September 11, 2020, 03:25:31 AM »
Translating lisp code can only really translate the messages or questions. The code seems to still need the operations to be in english.

"Insertion Units are Millimetres. Convert Areas & Coordinates to Metres : ?" "No") "Yes")
A man who never made a mistake never made anything

PM

  • Newt
  • Posts: 127
Re: help with coordinate table with area
« Reply #22 on: September 11, 2020, 04:29:01 AM »
Ok Dlanor i will wait . Thanks

HOSNEYALAA

  • Newt
  • Posts: 53
Re: help with coordinate table with area
« Reply #23 on: September 11, 2020, 07:53:25 AM »
اhi Dlanor  and PM

Block selection by fence
;;; ss (ssget "F" vlst '((0 . "INSERT") (66 . 1)))


Therefore, he chooses the blocks that pass through the polyline
The solution is primarily to scale all blocks by .8 so as not to choose the side blocks



HOSNEYALAA

  • Newt
  • Posts: 53
Re: help with coordinate table with area
« Reply #24 on: September 11, 2020, 07:56:40 AM »
this

d2010

  • Newt
  • Posts: 77
Re: help with coordinate table with area
« Reply #25 on: September 11, 2020, 09:33:09 AM »
Block selection by fence
;;; ss (ssget "F" vlst '((0 . "INSERT") (66 . 1)))
Step01) I add inside maxp and minp and calculateIterator between line07...line11
Code - Auto/Visual Lisp: [Select]
  1.   (setq noe (getint "\nEnter AreaName:(1.Youtube)(2.Facebook)(3.Yeromonah)(5.Handle):"))
  2.   (if (= noe 1) (setq mne "https://youtu.be/LGZ8aZXDkI4")
  3.     (if (= noe 2)
    --I restore to 100%Vlisp from code-source-step01. :wideeyed2:
    Step02)
    Step03)I compile the secondsource to
    • autoarom_jsldc11.lsp
    • autoarom_jsdup35.lsp
    Step04)I compile the mainsource to
    • MyPin-Code for Execute 6473=pp_tablegreece_jspin15.lsp
    • pp_tablegreece.lsp
« Last Edit: September 11, 2020, 12:17:13 PM by d2010 »

Dlanor

  • Bull Frog
  • Posts: 260
Re: help with coordinate table with area
« Reply #26 on: September 11, 2020, 09:43:10 AM »
Ok Dlanor i will wait . Thanks

Attached is revised lisp. This checks that the block is on the polyline, and within 10mm of a vertex. This should eliminate blocks on the polyline but not close to a vertex.

If the block isn't on the polyline it checks if the block is within 10mm of the polyline and 10mm of a vertex (max dist 14.14mm) This will eliminate blocks not on a vertex and not on the polyline.

This will allow for a minor misplacement of a block that perhaps should be on a polyline. Whatever happens the listed x and y coords are the coords of the closest vertex.

If you want this changing, please let me know.


PM

  • Newt
  • Posts: 127
Re: help with coordinate table with area
« Reply #27 on: September 11, 2020, 10:31:06 AM »
hi Dlanor. Now gives me this error

Quote
An Error : too many arguments occurred.


Dlanor

  • Bull Frog
  • Posts: 260
Re: help with coordinate table with area
« Reply #28 on: September 11, 2020, 10:49:16 AM »
Oops, added the correct file from the wrong location.  :crazy2:

Attached

PM

  • Newt
  • Posts: 127
Re: help with coordinate table with area
« Reply #29 on: September 11, 2020, 11:06:49 AM »
I have the same problem with the blocks near polyline .check the test2.dwg. Is problem because i can not trust the results of the table. I have any time to check all the coordinates.

Is not any other way to export polyline coordinates and use the names of the blocks on polyline vertex ?