Request - Re-create this lisp (its too complicated for me)

Hi lisp masters, i need your expertise guys.

I need someone to re-create this protected lisp.

(i dont want to deprotect it but remake/recreate/rewrite with the same functionality).

try the lisp.QW.lsp

reason, wantt to learn how he (some old guy here, but left the company many years ago)did it.

What does that lisp do ? can you upload a record view ( video ) of that function ?

What does that lisp do ? can you upload a record view ( video ) of that function ?

command is QW,

upon invoking it ask for a selection, any selection makes the current layer/linetype (incase if it selects a line/pline as default.

it can also select blocks and text.

its like a copy entity/object thing including properties.

note: i am going to remove the attached video after 12hrs.

sample.zip

Just a few codes for you to start with and I know that you can manage the rest of it for sure

(if (and (setq s (car (entsel "\nSelect any object :")))
        (wcmatch (cdr (assoc 0 (setq e (entget s))))
                 "LINE,*POLYLINE,CIRCLE,ARC")
        )
 (progn
   (if (cdr (assoc 6 e))
     (setvar 'CELTYPE (cdr (assoc 6 e)))
     (setvar 'CELTYPE "ByLayer")
     )
   (if (cdr (assoc 62 e))
     (setvar 'CECOLOR (itoa (cdr (assoc 62 e))))
     (setvar 'CECOLOR "ByLayer")
     )
   )
 )

Just a few codes for you to start with and I know that you can manage the rest of it for sure

 

(if (and (setq s (car (entsel "\nSelect any object :")))
        (wcmatch (cdr (assoc 0 (setq e (entget s))))
                 "LINE,*POLYLINE,CIRCLE,ARC")
        )
 (progn
   (if (cdr (assoc 6 e))
     (setvar 'CELTYPE (cdr (assoc 6 e)))
     (setvar 'CELTYPE "ByLayer")
     )
   (if (cdr (assoc 62 e))
     (setvar 'CECOLOR (itoa (cdr (assoc 62 e))))
     (setvar 'CECOLOR "ByLayer")
     )
   )
 )

this will be a good start.. many thanks my friend.

this will be a good start.. many thanks my friend.

You're welcome and good luck with your journey of coding .

Ask when you have obstacles .

Hi ttray33y . Did you re-create the code? Can you post it ?

(defun c:qwremake ()
 (if (and (setq s (car (entsel "\nSelect any object: ")))
   (wcmatch (cdr (assoc 0 (setq e (entget s))))
	    "LINE,*POLYLINE,CIRCLE,ARC"
   )
     )
   ;; This will set the properties for lines, polylines, circles and arcs
   (progn
     ;; linetype
     (if (cdr (assoc 6 e))
(setvar 'CELTYPE (cdr (assoc 6 e)))
(setvar 'CELTYPE "ByLayer")
     )
     ;; layer
     (if (cdr (assoc 8 e))
(setvar 'CLAYER (cdr (assoc 8 e)))
     )
     ;; color
     (if (cdr (assoc 62 e))
(setvar 'CECOLOR (itoa (cdr (assoc 62 e))))
(setvar 'CECOLOR "ByLayer")
     )
     ;; Now we run the command to recreate the same object type
     (command comm (cdr (assoc 0 (setq e (entget s)))))
   )
 )
)

I can't seem to get polylines to work. What gives? Also, am I heading in the right direction?

I plan on adding functionality for blocks next.

BTW I've been using Lee Mac's lisp to help determine assoc codes. It can be found here.

Hi iconeo ,

There is no need to check for the layer name if it has a value because it should always have in this case .

I think you have one extra word in your adds to the original codes of mine .

Hi iconeo ,

 

There is no need to check for the layer name if it has a value because it should always have in this case .

I think you have one extra word in your adds to the original codes of mine .

Thanks for the info. Here is my updated.

(defun c:qwremake ()
 (if (and (setq s (car (entsel "\nSelect any object: ")))
   (wcmatch (cdr (assoc 0 (setq e (entget s))))
	    "LINE,*POLYLINE,CIRCLE,ARC"
   )
     )
   ;; This will set the properties for lines, polylines, circles and arcs
   (progn
     ;; layer
     (setvar 'CLAYER (cdr (assoc 8 e)))
     ;; linetype
     (if (cdr (assoc 6 e))
(setvar 'CELTYPE (cdr (assoc 6 e)))
(setvar 'CELTYPE "ByLayer")
     )
     ;; color
     (if (cdr (assoc 62 e))
(setvar 'CECOLOR (itoa (cdr (assoc 62 e))))
(setvar 'CECOLOR "ByLayer")
     )
     ;; polyline width
     (if (cdr (assoc 43 e))
(setvar 'PLINEWID (cdr (assoc 43 e)))
     )
     ;; Now we run the command to recreate the same object type.
     (if (wcmatch (cdr (assoc 0 (setq e (entget s))))
	   "LINE,CIRCLE,ARC"
  )
(command comm (cdr (assoc 0 (setq e (entget s)))))
(command "pline")
     )
   )
 )
)

Now to tackle block handling. Any help on how to filter for blocks with assoc?

Cheers!

iconeo , as I have mentioned before that you have one extra word and that is comm and it is not needed

A little modification on the codes .

(defun c:qwremake (/ s en e plw)
 (if (and (setq s (entsel "\nSelect any object: "))
          (wcmatch (setq en (cdr (assoc 0 (setq e (entget (car s))))))
                   "LINE,*POLYLINE,CIRCLE,ARC,INSERT"
          )
     )
   (progn
     ;; layer
     (setvar 'CLAYER (cdr (assoc 8 e)))
     ;; linetype
     (if (cdr (assoc 6 e))
       (setvar 'CELTYPE (cdr (assoc 6 e)))
       (setvar 'CELTYPE "ByLayer")
     )
     ;; color
     (if (cdr (assoc 62 e))
       (setvar 'CECOLOR (itoa (cdr (assoc 62 e))))
       (setvar 'CECOLOR "ByLayer")
     )
     ;; polyline width
     (if (cdr (assoc 43 e))
       (progn
         (setq plw (getvar 'PLINEWID))
         (setvar 'PLINEWID (cdr (assoc 43 e)))
       )
     )
     (cond ((wcmatch en "LINE,CIRCLE,ARC")
            (command en)
           )
           ((eq en "INSERT")
            (command "_.copy"
                     s
                     ""
                     (cadr s)
                     "\\"
            )
           )
           ((wcmatch en "*POLYLINE") (command "pline"))
     )
     (setvar 'PLINEWID plw)
   )
 )
 (princ)
)

Before continuing thanks so much for your skill and time!

I really like how you handled the blocks. I had a working solution using insert but then I had to deal with scale and rotation which I didn't want to and yours works much better with dynamic blocks and the vis state.

However, I couldn't get your lisp to work properly concerning the PLINEWID. It didn't seem to want to set the value to PLINEWID after setting plw...not sure why as I tried different ways of doing it.

Anyways, I added ellipse support and now I'll work on hatches.

(defun c:qwremake (/ s en e plw)
 (if (and (setq s (entsel "\nSelect any object: "))
   (wcmatch (setq en (cdr (assoc 0 (setq e (entget (car s))))))
	    "LINE,CIRCLE,ARC,ELLIPSE,*POLYLINE,INSERT"
   )
     )
   (progn
     ;; layer
     (setvar 'CLAYER (cdr (assoc 8 e)))
     ;; linetype
     (if (cdr (assoc 6 e))
(setvar 'CELTYPE (cdr (assoc 6 e)))
(setvar 'CELTYPE "ByLayer")
     )
     ;; color
     (if (cdr (assoc 62 e))
(setvar 'CECOLOR (itoa (cdr (assoc 62 e))))
(setvar 'CECOLOR "ByLayer")
     )
     ;; polyline width
     (if (cdr (assoc 43 e))
(setvar 'PLINEWID (cdr (assoc 43 e)))
     )
     (cond ((wcmatch en "LINE,CIRCLE,ARC,ELLIPSE")
     (command en)
    ) ;end condition
    ((eq en "INSERT")
     (command "_.copy"
	      s
	      ""
	      (cadr s)
	      "\\"
     )
    ) ;end condition
    ((wcmatch en "*POLYLINE")
     (command "pline")
    ) ;end condition
     )
   )
 )
 (prompt "\nObject not compatible.")
 (princ)
)

Thank you.

iconeo .Nice code. Don't work with text ,spline and hatch yet ...

Thanks

iconeo .Nice code. Don't work with text ,spline and hatch yet ...

 

Thanks

Hey thanks. Original posters idea and Tharwat has been a huge help.

Planning on adding support for text, dimensions, hatches, and leaders. Any others you think I should address as well?

Hey thanks. Original posters idea and Tharwat has been a huge help.

 

Planning on adding support for text, dimensions, hatches, and leaders. Any others you think I should address as well?

	    ((eq en "INSERT")
     (command "_.copy"
	      s
	      ""
	      (cadr s)
	      "\\"
     )
    ) ;end condition

instead of "COPY", re-write this and try an insert function.

	    ((eq en "INSERT")
     (command "_.copy"
	      s
	      ""
	      (cadr s)
	      "\\"
     )
    ) ;end condition

instead of "COPY", try insert.

For my use case COPY works better. Then I don't have to mess with vis states of dynamic blocks, rotation, scale, etc.

If someone wanted to go the insert route Lee Mac's helper lisp routines could work well for the dynamic blocks.

Thanks.

more ideas keep it coming, we all know there are many ways to write this function..

I'm stuck on leaders and dimensions. How can I access user arrow override information? I believe it is in XDATA and I don't know how to read it properly or even work with it. Any help is appreciated.

Thanks.

I'm stuck on leaders and dimensions. How can I access user arrow override information? I believe it is in XDATA and I don't know how to read it properly or even work with it. Any help is appreciated.

 

Thanks.

try this for the qleader, sorry this is a noob routine.

(defun leader_a ()
  (progn 
     (setq dim_style (cdr (assoc 3 alist))
           lyr (cdr (assoc 8 alist))
     )     
     (command "-dimstyle" "r" dim_style
               "-layer" "s" lyr ""
               "qleader")
  )
)
(defun c:QW ()
(setvar "cmdecho" 1)   
  (setq alist (entget (car (entsel)))
        ent (cdr (assoc 0 alist))
  )     
  (if (= ent "LEADER") (leader_a))
(princ)          
)

can any one add something like this ?

(setq convert (cond ( (getkword "\nconvert to polylines? [Yes/No] <N>: ") ) ( "No" )))
         (if (eq "Yes" convert)
             (command "_.pedit" "_M" 2bjoin  "" "_J" "" ""))
         )
   )
   (setvar 'peditaccept ped)
)