Jump to content
xpr0

Create Similar (CS) for AutoCAD - lisp req.

Recommended Posts

xpr0

hello everyone

In revit we've a command/tool called ''Creat Similar CS'' which creates similar element More info here, so i was wondering the other day that is there a lisp for autocad that if you select an existing object in a drawing then it initiates the command to creats an exact similar object with all its properties, and lets you draw/creat a  new shape (line, polyline, circle etc) or text, mtext, hatch, dimension, mleaders etc. based on the properties of the previously selected source object. so basically it'b be a reverse version of match properties. if such lisp exists please point me in that direction, or i requests the experts here to write a new one, it'll be usefull for all of us. thanx.

Share this post


Link to post
Share on other sites
BIGAL

Yes, apologise had this for a few years do not have authors name.

; matches pick object for next command plus layer
(defun c:ZZZ (/ ent Obj lEnt)
  (vl-load-com)
  (while (setq ent (car (nentsel "\nSelect Object: ")))
    (setq Obj (vlax-ename->vla-object ent)
          typ (cdr (assoc 0 (entget ent))))
    (cond ((vl-position typ '("CIRCLE" "ARC" "ELLIPSE" "SPLINE" "XLINE"))
           (comInv typ nil) (PropMatch Obj (entlast)))
          ((eq "LWPOLYLINE" typ)
           (comInv "pline" nil) (PropMatch Obj (entlast)))
          ((eq "LINE" typ)
           (setq lEnt (entlast))
           (comInv typ nil)
           (foreach ent (EntCol (if lEnt lEnt (entlast)))
             (PropMatch Obj ent)))
          ((eq "HATCH" typ)
           (setq lEnt (entlast))
           (comInv typ t)
           (if (not (eq lEnt (entlast)))
             (PropMatch Obj (entlast))))
          ((eq "VIEWPORT" typ)
           (setq lEnt (entlast))
           (comInv "-vports" nil)
           (if (not (eq lEnt (entlast)))
             (PropMatch Obj (entlast))))))
  (princ))

(defun PropMatch (bObj dObj)
  (or (eq 'VLA-OBJECT (type bObj))
      (setq bObj (vlax-ename->vla-object bObj)))
  (or (eq 'VLA-OBJECT (type dObj))
      (setq dObj (vlax-ename->vla-object dObj)))
  (foreach prop '(Layer
                  Linetype
                  LinetypeScale
                  Color
                  Lineweight
                  ViewportOn
                  ShadePlot
                  DisplayLocked                  
                  GradientAngle
                  GradientCentered
                  GradientColor1
                  GradientColor2
                  GradientName
                  HatchObjectType
                  HatchStyle
                  ISOPenWidth
                  Origin
                  PatternAngle
                  PatternDouble
                  PatternScale
                  PatternSpace)
    (if (and (vlax-property-available-p bObj prop)
               (vlax-property-available-p dObj prop T))
      (vlax-put-property dObj prop
        (vlax-get-property bObj prop)))))

(defun EntCol (x / x)
  (if (setq x (entnext x))
    (cons x (EntCol x))))

(defun comInv (com flag)
  (if flag (initdia))
  (command (strcat "_." com))
  (while (eq 1 (logand 1 (getvar "CMDACTIVE")))
    (command pause)))

 

 

  • Thanks 1

Share this post


Link to post
Share on other sites
BIGAL

Added "Original code by lee-mac".

Share this post


Link to post
Share on other sites
xpr0
11 hours ago, BIGAL said:

Yes, apologise had this for a few years do not have authors name.


; matches pick object for next command plus layer
(defun c:ZZZ (/ ent Obj lEnt)
  (vl-load-com)
  (while (setq ent (car (nentsel "\nSelect Object: ")))
    (setq Obj (vlax-ename->vla-object ent)
          typ (cdr (assoc 0 (entget ent))))
    (cond ((vl-position typ '("CIRCLE" "ARC" "ELLIPSE" "SPLINE" "XLINE"))
           (comInv typ nil) (PropMatch Obj (entlast)))
          ((eq "LWPOLYLINE" typ)
           (comInv "pline" nil) (PropMatch Obj (entlast)))
          ((eq "LINE" typ)
           (setq lEnt (entlast))
           (comInv typ nil)
           (foreach ent (EntCol (if lEnt lEnt (entlast)))
             (PropMatch Obj ent)))
          ((eq "HATCH" typ)
           (setq lEnt (entlast))
           (comInv typ t)
           (if (not (eq lEnt (entlast)))
             (PropMatch Obj (entlast))))
          ((eq "VIEWPORT" typ)
           (setq lEnt (entlast))
           (comInv "-vports" nil)
           (if (not (eq lEnt (entlast)))
             (PropMatch Obj (entlast))))))
  (princ))

(defun PropMatch (bObj dObj)
  (or (eq 'VLA-OBJECT (type bObj))
      (setq bObj (vlax-ename->vla-object bObj)))
  (or (eq 'VLA-OBJECT (type dObj))
      (setq dObj (vlax-ename->vla-object dObj)))
  (foreach prop '(Layer
                  Linetype
                  LinetypeScale
                  Color
                  Lineweight
                  ViewportOn
                  ShadePlot
                  DisplayLocked                  
                  GradientAngle
                  GradientCentered
                  GradientColor1
                  GradientColor2
                  GradientName
                  HatchObjectType
                  HatchStyle
                  ISOPenWidth
                  Origin
                  PatternAngle
                  PatternDouble
                  PatternScale
                  PatternSpace)
    (if (and (vlax-property-available-p bObj prop)
               (vlax-property-available-p dObj prop T))
      (vlax-put-property dObj prop
        (vlax-get-property bObj prop)))))

(defun EntCol (x / x)
  (if (setq x (entnext x))
    (cons x (EntCol x))))

(defun comInv (com flag)
  (if flag (initdia))
  (command (strcat "_." com))
  (while (eq 1 (logand 1 (getvar "CMDACTIVE")))
    (command pause)))

 

 

thanx for your reply Bigal, but this lisp do not work on dimensions, text, mtext, hatch & most of time i'll be using this lisp for dimensions, text & mtext, so plz could you or someone else modify it to work with the same. thanx

Edited by xpr0

Share this post


Link to post
Share on other sites
xpr0
17 hours ago, Least said:

Quickdraw by VVA

 

http://www.cadtutor.net/forum/showthread.php?p=283554#post283554

 

looking at VVA's post on the swamp there is also a command.

PS: Beginning with the 2011 version has a similar command _ADDSELECTED

this lisp is good, but still there're some issues with it, anyway ADDSELECTED 'll work nicely for me. thanx for your help. 

Share this post


Link to post
Share on other sites

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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

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