Jump to content

HelpME .. How can I convert list

hosneyalaa

By hosneyalaa
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

hosneyalaa Community Regular

hosneyalaa

Posted
Posted

My language is good

 

Hello everyone

If I have a list the list format

'(2.02512 7.5831 2.03903 7.58318)

 

How can I convert it to the following format

 

'("\\P2.025\\P7.583\\P2.039\\P7.583")

I I want to add //P  TO the list

Then convert it to list without spaces

The goal is
You Writing in the table cell within several lines

As is attached

 

Thanks in advance

 

Capture.PNG

Tharwat Grand Master

Tharwat

Posted
Posted

Hi,

Try this untested codes.  

(foreach prt '(2.02512 7.5831 2.03903 7.58318)
  (setq lst (cons (strcat "\\P" (vl-princ-to-string prt)) lst))
  )

(setq out (apply 'strcat (reverse lst)))

 

  • Thanks 1
Tharwat Grand Master

Tharwat

Posted
Posted

Another with 3 decimal numbers with another method. :)  

(setq str "")

(foreach prt '(2.02512 7.5831 2.03903 7.58318)
  (setq str (strcat str "\\P" (rtos prt 2 3)))
)

 

  • Thanks 1
Lee Mac Grand Master

Lee Mac

Posted
Posted (edited) 
(apply 'strcat (mapcar '(lambda ( x ) (strcat "\\P" (rtos x 2 3))) lst))

Or, without the leading "\\P": 

(apply 'strcat (cons (car lst) (mapcar '(lambda ( x ) (strcat "\\P" (rtos x 2 3))) (cdr lst)))

 

Edited by Lee Mac
  • Thanks 1
hosneyalaa Community Regular

hosneyalaa

Posted
  • Author
Posted

Thanks to all

 

image From the work of Lisp

After help me

 

THIS LISP 

 

;;;;; https://forums.augi.com/showthread.php?135690-Get-Polyline-segments
;;;(SETQ objPline objSelection)
(defun GetVerticies (objPline / intParam lstVerticies)
 (repeat (1+ (setq intParam (fix (vlax-curve-getendparam objPline))))
  (setq lstVerticies (cons (vlax-curve-getpointatparam objPline (float intParam)) lstVerticies))
  (setq intParam (1- intParam))
 )
 lstVerticies 
)


;;;(SETQ lstVerticies lstReturnXY)
(defun GetSegments (lstVerticies)
 (mapcar '(lambda (X Y) (- (if (eq Y (last lstVerticies)) (vlax-curve-getdistatparam objSelection (vlax-curve-getendparam objSelection)) (vlax-curve-getdistatpoint objSelection Y)) (vlax-curve-getdistatpoint objSelection X)))          
          (reverse (cdr (reverse lstVerticies))) 
          (cdr lstVerticies) 
 )
)
(defun AREA1(e) (vlax-curve-getarea e ))


(defun LM:lst->str ( lst del / str )
    (setq str (car lst))
    (foreach itm (cdr lst) (setq str (strcat str del itm)))
    str
)
;;;(setq enm objSelection) 
(defun _Matrialnumber (enm / p sel str l)
  (setq p (vlax-curve-getEndParam enm))
      (repeat (setq p (1+ (fix p)))
        (setq l (cons (vlax-curve-getPointAtParam enm (setq p (1- p))) l))
      )
          (setq sel (ssget "_CP" l '((0 . "TEXT"))))
           (vlax-for tx (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
                          (if  (not (distof (vla-get-textstring tx)))
                           (ssdel  (vlax-vla-object->ename tx)  sel)))
            (setq str (cdr (assoc 1 (entget (ssname sel 0)))))
            )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:TEST (/ intCount 
                  lstReturn1
                  lstReturn2
                  lstReturn3
                  lstReturn4
                  objSelection
                  ssSelections
                  strCSVFilename
                  z
                  alertmsg
                  lin
               )
 (vl-load-com)
 (if (setq ssSelections (ssget (list (cons 0 "LWPOLYLINE,POLYLINE"))))
  (progn
   (setq intCount -1)
   (repeat (sslength ssSelections)
        (setq intCount     (1+ intCount))
       (setq  objSelection (vlax-ename->vla-object (ssname ssSelections intCount)))
       (setq lstReturnXY (getverticies objSelection))
      
       (setq  lstReturn1 (getsegments lstReturnXY))
     
       (setq xs0(mapcar (function (lambda(x)(rtos x 2 3)))lstReturn1));; LENGTH
       
             (setq xs1 (LM:lst->str xs0 "\n "))    
       (setq LLL (AREA1 objSelection)); AREA
       (SETQ Per (vlax-curve-getDistAtParam objSelection (vlax-curve-getEndParam objSelection)));perimeter

       (setq numberstr (_matrialnumber objSelection))
          
     
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (setq I 0)
     (repeat (- (LENGTH lstReturnXY) 1)
           (setq pt1 (nth i lstReturnXY))
           (setq  pt2 (nth (+ 1 i) lstReturnXY))
;;;       (setq  pt1_D(vlax-curve-getDistAtPoint objSelection pt1));start point_1
           (setq  pt1_D (vlax-curve-getdistatparam objSelection I))
;;;           (setq pt2_D(vlax-curve-getDistAtPoint objSelection pt2));start point_2
           (setq  pt2_D (vlax-curve-getdistatparam objSelection (+ 1 i)))
           (setq ptM_D(+ (/ (- pt2_D pt1_D) 2) pt1_D))
           (Setq ptM_DP (vlax-curve-getPointAtDist objSelection ptM_D));start point_1
           (setq  ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv objSelection (vlax-curve-getparamatpoint objSelection ptM_DP))))
       (setq  LLN(entmakex (list '(0 . "LINE") (cons 10 (setq pt_B(polar ptM_DP (+ ang (/ pi 2.)) 0.5))) (cons 11 (setq pt_E(polar ptM_DP (- ang (/ pi 2.)) 0.5))))))
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
           (setq js (entlast))
           (setq  objLL (vlax-ename->vla-object js))
           (setq  ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv objLL (vlax-curve-getparamatpoint objLL pt_B))))
           (setq fuzz 1)
           (setq f_S(ssget "_CP" (list (polar pt_B (+ ang (/ pi 2.)) fuzz)
                    (polar pt_B (- ang (/ pi 2.)) fuzz)
                    (polar pt_E (- ang (/ pi 2.)) fuzz)
                    (polar pt_E (+ ang (/ pi 2.)) fuzz))'((0 . "LWPOLYLINE,POLYLINE")) )) 
           (SSlength f_S)
           
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;          (setq fuzzS(gettouching (LIST LLN) ssSelections))
          (IF (= (SSlength f_S) 1)
         (PROGN
          (setq L_ROAD (cons (- pt2_D pt1_D) L_ROAD))
          (setq I (+ 1  I))
          (entdel js)
          (setq f_S NIL)
          (setq f_ST(ssget "_CP" (list (polar pt_B (+ ang (/ pi 2.)) fuzz)
                    (polar pt_B (- ang (/ pi 2.)) fuzz)
                    (polar pt_E (- ang (/ pi 2.)) fuzz)
                    (polar pt_E (+ ang (/ pi 2.)) fuzz))'((0 . "TEXT")) ))
          (setq str (cdr (assoc 1 (entget (ssname f_ST 0)))))
          (setq L_ROADT (cons str L_ROADT))
          (setq L_ROADTALL (cons str L_ROADTALL))
          )
          (PROGN
        (setq f_ST(ssget "_CP" (list (polar pt_B (+ ang (/ pi 2.)) fuzz)
                    (polar pt_B (- ang (/ pi 2.)) fuzz)
                    (polar pt_E (- ang (/ pi 2.)) fuzz)
                    (polar pt_E (+ ang (/ pi 2.)) fuzz))'((0 . "TEXT")) ))
        (setq str (cdr (assoc 1 (entget (ssname f_ST 0)))))
        (setq L_ROADTALL (cons str L_ROADTALL))
        (setq I (+ 1  I))
          (entdel js)
          (setq f_S NIL)
        )
        )
    );REPEET ONE POLYLINE 
     (setq xs1T (LM:lst->str L_ROADTALL "\n "))
     (SETQ L_ROADQ (mapcar '(lambda ( x Y ) (LIST X Y)) L_ROAD L_ROADT ))
      (setq ptLst(vl-sort
                (mapcar '(lambda(x)(list (cAr X) (cAdr X)))
                     L_ROADQ)
                '(lambda(a b)(>(car a)(car b)))))
     
      (setq xs0R(mapcar (function (lambda(x)(rtos (CAR x) 2 3)))ptLst));; LENGTH
      (setq xs0RT(mapcar (function (lambda(x)(CADR x)))ptLst))
       
      (setq xs1R (LM:lst->str xs0R "\n "))
      (setq xs1RT (LM:lst->str xs0RT "\n "))

     (setq L_RC(CONS (LIST numberstr (rtos LLL) (rtos Per) xs1T xs1 xs1RT xs1R) L_RC));(("CHAINAGE" "X=" "Y=" "X=" "Y=" "X=" "Y=") ("0+000.000" "17.60" "-6.44" "16.71" "-5.99" "19.38" "-7.35"))
     (setq L_ROAD NIL)
     (setq L_ROADT NIL)
      (setq xs0 NIL)
     (setq xs1 NIL)
      (setq L_ROADTALL NIL)
     (setq xs1T NIL)
      (setq L_ROADQ NIL)
     (setq xs0R NIL)
     (setq xs0RT NIL)
     (setq xs1R NIL)
     (setq xs1RT NIL)

     );REPEET ALL POLYLINES
   );PROGN
   
;;;   (setq xvals (vl-sort L_RC '(lambda(x1 x2) (< (atof(car x1)) (atof(car x2))))))
   
   );IF
  (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
   (and     L_RC
                          (setq CollectedData (vl-sort L_RC
                                  '(lambda  ( m n)
                                         (< (atoi (car m))(atoi (car n))))))
                    (setq basepoint (getpoint "\nPick point for Table:"))
                    (setq SupportDrawingTable
                           (vlax-invoke (vlax-get (vla-get-ActiveLayout aDoc) 'Block)
                                                'Addtable basepoint
                        2  7 0.35 2.5     )
                    )
                          (progn
                        (vla-setcelltextheight SupportDrawingTable 0 0 0.18)
                        (vla-settext SupportDrawingTable 0 0 "Your Title")
                                (vla-put-regeneratetablesuppressed SupportDrawingTable :vlax-false)
                                    (mapcar '(lambda (y)
                          (vla-settext SupportDrawingTable 1 (car y) (cadr y))
                              (vla-setcelltextheight SupportDrawingTable 1 (car y) 0.18))
                             '((0 "Number")(1 "AREA")(2 "Perimeter")(3 "NAME_LENGTH")(4 "LENGTH")(5 "NAME_LENGTH")(6 "LENGTH_ON_ROAD")))
                        (vla-InsertRowsAndInherit SupportDrawingTable 2 1 (setq i (length CollectedData)))
                                (setq row 1)
;;;                                    (setq rowQ NIL)
;;;                                    (setq rowQ '("\\P2.025\\P7.583\\P2.039\\P7.583"))
;;;                                     (setq rowQ (CONS (LIST 125) rowQ))
                                      (foreach itm CollectedData
                             
                                          (vla-settext SupportDrawingTable (setq row (1+ row)) 0 (nth 0 itm))
;;;                                          (vla-settext SupportDrawingTable row 1 (strcat "b"(rtos (caaddr itm) 2 2)"\n" (rtos (cadr (caddr itm)) 2 2) "\n" (cadr itm) ))
                              (vla-settext SupportDrawingTable row 1 (strcat (nth 1 itm)))
                              (vla-settext SupportDrawingTable row 2 (strcat (nth 2 itm)))
                              (vla-settext SupportDrawingTable row 3 (strcat (nth 3 itm)))
                              (vla-settext SupportDrawingTable row 4 (strcat (nth 4 itm)))
                              (vla-settext SupportDrawingTable row 5 (strcat (nth 5 itm)))
                              (vla-settext SupportDrawingTable row 6 (strcat (nth 6 itm))))                           
                        (vla-put-regeneratetablesuppressed SupportDrawingTable :vlax-false)
                              )
                      )


);END C 
     

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Q1.PNG

BIGAL Grand Master

BIGAL

Posted
Posted

I think if you had done some homework googling you may have found what you want at Lee-mac.com.

 

Remember we offer our services for free. Not do this for me.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...