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

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)
)

I probably won't for this lisp but here is what I use in my day to day. I have it stored under the mouse double click in the CUI. So all I have to do to convert a line to pline is double click on it. Then you can use the right click contextual menu to join it to whatever you want. The magic is in the double click though. So easy...

I finally found some code that I think will allow me to implement custom user blocks in leaders but I have yet to implement it. I still have to add test, leaders, and dimensions to this project but here it is as it stands.

I realize for some use cases that the way blocks work might not be the most desirable. I might add a toggle for the user to choose how this works. Also, I should probably add functionality for a user to be able to select nested objects properly if desired.

Thanks.

(defun c:qw (/ 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,HATCH"
   )
     )
   (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)))
     )
     ;; hatch information
     (if (wcmatch en "HATCH")
(progn
  (setvar 'HPSCALE (cdr (assoc 41 e)))
  (setvar 'HPANG (cdr (assoc 52 e)))
  (setvar 'HPNAME (cdr (assoc 2 e)))
  (setvar 'HPLAYER (cdr (assoc 8 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
    ((wcmatch en "HATCH")
     (command "bhatch")
    ) ;end condition
     )
   )
 )
 (prompt "\nObject not compatible.")
 (princ)
)

Updated to include rectangles and leaders.

(defun c:qw (/ s en e vla_s)
 (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,HATCH,LEADER"
 )
   )
    (progn

      ;; This group of settings are common to all objects
      ;; 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")
      )

      ;; The following settings are object type specific
      ;; polyline width
      (if (wcmatch en "*POLYLINE")
 (setvar 'PLINEWID (cdr (assoc 43 e)))
      )
      ;; hatch information
      (if (wcmatch en "HATCH")
 (progn
   (setvar 'HPSCALE (cdr (assoc 41 e)))
   (setvar 'HPANG (cdr (assoc 52 e)))
   (setvar 'HPNAME (cdr (assoc 2 e)))
   (setvar 'HPLAYER (cdr (assoc 8 e)))
 )
      )

      ;; The following ensures that the correct command is run in order
      ;; create a similar object
      (cond ((wcmatch en "LINE,CIRCLE,ARC,ELLIPSE")
      (command en)
     )				;end condition
     ((eq en "INSERT")
      (command "_.copy"
	       s
	       ""
	       (cadr s)
	       "\\"
      )
     )				;end condition
     ((wcmatch en "*POLYLINE")
      (if (= (cdr (assoc 90 e)) 4)
	(command "rectang")
	(command "pline")
      )	      
     )				;end condition
     ((wcmatch en "HATCH")
      (command "bhatch")
     )				;end condition
      )
      (if (wcmatch en "LEADER")
 (progn
   (setvar "DIMASZ" 0.125)
   ;;convert to vl object
   (setq vla_s (vlax-ename->vla-object (car s)))
   (if (= (vla-get-ArrowheadBlock vla_s) "")
     (setvar "DIMLDRBLK" ".")
     (setvar "DIMLDRBLK" (vla-get-ArrowheadBlock vla_s))
   )

   (command "LEADER" pause pause pause "" "" "none")

   ;; Alternate method to set arrowhead block
   ;;(setq vla_s (vlax-ename->vla-object (entlast)))
   ;;(vla-put-ArrowheadBlock vla_s LeaderName)
 )
      )
    )
    (prompt
      "\nObject is not a LINE,CIRCLE,ARC,ELLIPSE,POLYLINE,BLOCK,HATCH, or LEADER."
    )
    ;;^C^C(COMMAND "LAYER" "M" "S-ANNO-TEXT" "C" "7" "" "") 'textstyle standard 'textsize $M=$(if,$(=,$(getvar,cvport),1),0.09375,$(*,0.09375,$(getvar,dimscale))) mtext;
 )
 (princ)
)

:notworthy:neat lisp, I tested it out on a leader, while it matched the style and layer, the arrow size did not. Still better than I can code any day hands down.

Ah sorry, the leader size is specific to my firm. It is the DIMASZ variable that gets set under LEADER. You could probably just remove it and it should work fine for most of your use cases.

Thanks!

worked great, many thanks.

No problem.

I guess a better solution would be to change it like so:

	 (progn
   ;;convert to vl object
   (setq vla_s (vlax-ename->vla-object (car s)))
          (setvar "DIMASZ" (vla-get-ArrowheadSize vla_s))
   (if (= (vla-get-ArrowheadBlock vla_s) "")

No problem.

 

I guess a better solution would be to change it like so:

 

     (progn
      ;;convert to vl object
      (setq vla_s (vlax-ename->vla-object (car s)))
          (setvar "DIMASZ" (vla-get-ArrowheadSize vla_s))
      (if (= (vla-get-ArrowheadBlock vla_s) "")

I'll try to add it in, as well as a few other features like multi leader and dimension. It may be a while because it looks like "greek" to me, but that won't stop me from trying.