Jump to content

Recommended Posts

Posted

I wanna make a key for calling TORIENT and write this code:

 

(DEFUN C:t () (COMMAND "TORIENT"))

Why doesn't this code run???::?

Posted
I wanna make a key for calling TORIENT and write this code:

 

(DEFUN C:t () (COMMAND "TORIENT"))

Why doesn't this code run???::?

 

Because "Torient" is actually a lisp. Thus, your code should read:

 

(DEFUN C:t () (C:TORIENT))

Posted

thanxxxxxxxxxxxxxxxxxxxxxx alot mate

Posted

I would not recommend naming a command 't

 

It would overwrite a protected symbol. -David

Posted
I would not recommend naming a command 't

 

It would overwrite a protected symbol. -David

 

Only if (defun t ( ) ... ) is used, here the defined symbol is c:t

Posted

I always made mine "tor" anyways. Personally...

Posted
I would not recommend naming a command 't

 

It would overwrite a protected symbol. -David

Sounds like it's not fully protected, doesn't it? You would think it would be, though.
Posted
Sounds like it's not fully protected, doesn't it? You would think it would be, though.

 

Though the symbol being defined is 'c:t' in this case, not 't'.

Posted
Though the symbol being defined is 'c:t' in this case, not 't'.
Yep, you said that earlier, and I figured that earlier still, just like you. But it doesn't change the fact that the symbol T, to which David meant to refer, is out there for the changing, if anyone is careless enough to make that move. While a command doesn't run that risk, a simple defun, as you pointed out does, because the symbol isn't really protected. In fact, a simple setq can do/undo it. Is anyone suggesting otherwise? While I'm at it, I would recommend naming commands with longer names for clarity, then using the .pgp file to create a shortcut for it.
Posted
But it doesn't change the fact that the symbol T, to which David meant to refer, is out there for the changing, if anyone is careless enough to make that move. While a command doesn't run that risk, a simple defun, as you pointed out does, because the symbol isn't really protected.

 

The behaviour you describe is dependent upon the 'SETQ to protected symbols' setting within the General Options dialog (under Tools > Environment Options) in the VLIDE.

 

Setting this to 'Error' will cause AutoCAD to throw an error when a program attempts to redefine a protected symbol such as t.

Posted

Let me bring it to professionals

 

What´s is right command?

 



(defun c:pline-coor ( / *error* data-lst sorted-lst str-lst top-str polys
                                data cnt obj file-nm tmp item tmp-str fl)

 (defun *error* (msg)
   (if(= msg "quit / exit abort")
     (princ "\nNo output file was selected")
     (princ msg)
   )
 )
 
 (setq top-str ""
       file-nm (getfiled "Output File" "" "doc" 1)
 )
 (if(null file-nm)(exit))
 (if(setq polys(ssget '((0 . "*POLYLINE"))))
   (repeat(setq cnt(sslength polys))
     (setq obj      (vlax-ename->vla-object
                      (ssname polys 
                        (setq cnt(1- cnt))
                      )
                    )
           data-lst (cons
                      (list(vlax-get obj 'Layer) 
                      (vlax-get-property obj 'Coordinates)  [color=red]The problem line!![/color]
                      
                      )           
                      data-lst
                    ) 
     )
   )
 )
 (while data-lst
   (setq data     (car data-lst)
         data-lst (cdr data-lst)
         tmp      (list data)
   )
   (foreach item data-lst
     (if(=(car item)(car data))
       (setq tmp      (cons item tmp)
             data-lst (vl-remove item data-lst)
       )
     )
   )
   (setq sorted-lst(cons tmp sorted-lst))
 )
 (setq sorted-lst
   (vl-sort sorted-lst '(lambda(a b)(<(caar a)(caar b))))
 )
 (foreach item (reverse sorted-lst)
   (setq top-str
     (strcat(caar item)"," top-str)
   )
 )
 (setq str-lst (cons top-str str-lst)
       cnt     0
 )
 (repeat(apply 'max(mapcar 'length sorted-lst))
   (setq tmp-str "")
   (foreach item (reverse sorted-lst)
     (setq tmp-str
       (if(setq tmp(nth cnt item))
         (strcat(rtos(cadr tmp)) "," tmp-str)
         (strcat "," tmp-str)
       )
     )
   )
   (setq cnt     (1+ cnt)
         str-lst (cons tmp-str str-lst)
   )
 )
 (if(setq fl(open file-nm "w"))
   (progn
     (foreach str (reverse str-lst)
       (write-line str fl)
     )
     (close fl)
     (alert(strcat file-nm " was created"))
   )
   (alert "Unable to create file")
 )
 (princ)
)






 

I think it almost there...

Posted

Not 100% sure what you ae trying to get there, but if ou are trying to get all of the coordinates of the polylines in point format, you should try sending 'obj' to this sub function.

 

(defun vex-plverts(ent / retn listy retDum add1 add2);
 (vl-load-com)
 (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
   (progn
     (setq retn nil listy (vlax-safearray->list (vlax-variant-value (vla-get-coordinates (vlax-ename->vla-object ent)))))
     (while (and (setq var1 (car listy)) (setq var2 (cadr listy)))
(setq retn (append retn (list (list var1 var2 0))))
(setq listy (cddr listy)))
     )
   )
 retn
 ); Returns a list of 3D coordinates defining the vertices of a polygon

 

So, in short this line:

 

(vlax-get-property obj 'Coordinates)  [color=red]The problem line!![/color]

 

would now be:

(vex-plverts (ssname polys cnt)) 

Posted

This is more than enough .

 

(vlax-get <vla-object> 'Coordinates)

Posted

The objetive is export to a DOC or txt the value of Vertex X, Y + layername by side like this;

original sample;

 

exchange;

(vlax-get-property obj 'Coordinates) The problem line!!

 

For this;

 

(vlax-get obj 'Area)

 

will work fine for take value area + layername

 

Tip work with DOC:

 

have to change "," to "^t" to part number to paste in excel. afeter a new special paste in excel

with option tranpor to change line to columm information to a better viewer.

 

the target is X,Y + layername

 

Thank for support

 

Posted

I dodnt know if i doing right but i got some coords results in command line with this

"(vex-plverts (ssname polys cnt))"

 

but no layernames...

Posted
I dodnt know if i doing right but i got some coords results in command line with this

"(vex-plverts (ssname polys cnt))"

 

but no layernames...

Sounds right, It won't be until you 'cons' with the code that you have already written that it will return the layer name as well...

Posted

thanks for help Commandobill, Sorry for my ignorance but i would like to do 'cons' with the code, but i rolled myseft with it.

i thounght it will be more easy.

Posted

Since I'm against re-writing things, I stole this from Lee Mac years ago. Your code seems to sort the points in order, but you didn't say you needed that. If you do, I can throw that in here as well.

 

;; Polyline Vertex Exporter ~ by Lee McDonnell ~ 26.11.2009
(defun c:pExp (/ ss tmp i j ent tot dis pt)
(vl-load-com)
(if (and (setq ss (ssget '((0 . "*POLYLINE"))))
(setq tmp (getfiled "Output File" (cond (*load) ("")) "txt;csv" 9)))
(progn
(setq *load tmp tmp (open tmp "a") i -1)
(write-line "X,Y,Layer" tmp)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq tot 0. j (1- (vlax-curve-getStartParam ent)))
(while (<= (setq j (1+ j)) (vlax-curve-getEndParam ent))
(setq pt (mapcar 'rtos (vlax-curve-getPointatParam ent j))) 
(write-line
(strcat (car pt) (chr 44) (cadr pt) (chr 44) (vla-get-layer (vlax-ename->vla-object ent)))
tmp))
(write-line "" tmp))
(close tmp)))
(princ))

Posted

ohh that new one i had got different verion on my storge(under). very similar just will need change "distance" for layer" very nice, i´ll try it.

 

unfortunately the great tools like PtManagerV2-4.lsp and Geo_Export_v2_6.VLX give not this possibility.

 

Thank a lot for help new one Mr.Commandobill!!!

 

;; Polyline Vertex Exporter  ~   by Lee McDonnell  ~  27.11.2009

(defun c:pExp (/ *error* ObjRel ss col row ent tot j pt)
 (vl-load-com)

 (defun *error* (e)
   (ObjRel (list xlApp xlCells))
   (or (wcmatch (strcase e) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error : " e " **")))
   (princ))

 (defun ObjRel (lst)
   (mapcar
     (function
       (lambda (x)
         (if (and (eq (type x) 'VLA-OBJECT) (not (vlax-object-released-p x)))
           (vl-catch-all-apply 'vlax-release-object (list x))))) lst))

 (if  (setq i -1 ss (ssget '((0 . "*POLYLINE"))))
   (progn
     (setq xlApp     (vlax-get-or-create-object "Excel.Application")                
           xlCells   (vlax-get-property
                       (vlax-get-property
                         (vlax-get-property
                           (vlax-invoke-method
                             (vlax-get-property xlApp "Workbooks")
                             "Add")
                           "Sheets")
                         "Item" 1)
                       "Cells") col 0 row 1)

     (mapcar (function
               (lambda (x)
                 (vlax-put-property xlCells "Item" row (setq col (1+ col)) x)))
             '("Point""X""Y""Z""Distance""Total"))

     (while (setq ent (ssname ss (setq i (1+ i))))
       (setq tot 0. row (1+ row) j (1- (vlax-curve-getStartParam ent)))

       (while (<= (setq j (1+ j)) (vlax-curve-getEndParam ent))
         (setq col 0 pt (mapcar 'rtos (vlax-curve-getPointatParam ent j)))          

         (mapcar
           (function
             (lambda (x)
               (vlax-put-property xlCells "Item" row (setq col (1+ col)) x)))
           
           (list   (rtos (1+ j) 2 0)
                   (car pt)  (cadr pt) (caddr pt) 
                   (rtos (setq dis (- (vlax-curve-getDistatParam ent j)
                                      (if (zerop j) 0 (vlax-curve-getDistatParam ent (1- j)))))) 
                   (rtos (setq tot (+ dis tot)))))
         
         (setq row (1+ row))))
     
     (vlax-put-property xlApp 'Visible :vlax-true)
     (ObjRel (list xlApp xlCells))))

 (princ))

Whooaah!!!:D

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.

×
×
  • Create New...