make current line properties routine lsp

June 22, 2023

hello all:

I would like to know if there is a routine that does the following:

click on any line , and after this be able to draw a line with the same properties (color, linetype, layer, scale)

that is, activate the variables of the selected line to draw future lines, polylines or circles.

similar to matchprop.

June 22, 2023

June 22, 2023

I didn't know that command. and it's OK.

but i talk about take the properties of the line

and adjust the variables, then you can draw lines, polylines ,circles,

with the same properties of the parent object (color, linetype, layer, scale).

your advice is good.

but what i need is similar

June 22, 2023

Are you thinking about an extension of the LAYMCUR command? That one changes the current layer to an object you select. You want to change the current color, linetype, and linetype scale to that object's properties as well as the layer. Is that correct?

June 22, 2023

Exactly.

is that what you said

June 22, 2023

Give this a shot and let me know.

(defun c:Test (/ *error* sel get lay clr lty scl var val )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (defun *error* (msg)
    (and val (mapcar 'setvar var val))
    (if (and msg (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ "\n*Cancel*"))
      (princ (strcat "\nError => " msg)))
    )
  (if (and (setq sel (car (entsel "\nSelect object to get properties from : ")))
           (setq get (entget sel)
                 lay (cdr (assoc 8 get))
                 )
           (or (/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" lay))))))
               (alert "Object resides on locked layer!. Try again")
               )
           (setq clr (cond ((cdr (assoc 62 get))) (256)))
           (setq lty (cond ((cdr (assoc 06 get))) ("ByLayer")))
           (setq scl (cond ((cdr (assoc 48 get))) (1.0)))
           (setq var '(CECOLOR CELTYPE CLAYER)
                 val (mapcar 'getvar var)
                 )
           (mapcar 'setvar var (list (itoa clr) lty lay))
           )
    (progn
      (vl-cmdf "_.LINE")
      (while (= (getvar 'CMDACTIVE) 1)
        (entmod (append (entget (entlast)) (list (cons 48 scl))))
        (vl-cmdf "\\"))
      )
    )
  (*error* nil)
  (princ)
  )

June 22, 2023

Another way is draw an object with predefined settings layer, linetype, color etc. So would have some shortcuts like B1, B2 to draw beams with correct settings.

We also had a group of lines with predefined set up, and would just paste to the edge of our project so using say Tharwat code they are all available.

Ps saved in a layout not model so would use Ctrl+X to cut then go to model and paste Ctrl+V.

June 23, 2023

This command allows you to clone a command from an entity already placed in the drawing.
Use:
Run the DYN_CLONE command
Move the cursor over an entity in the drawing: The name of the entity appears in the status bar, instead of the coordinates.
If this entity suits you, validate with a right-click and the appropriate command will be launched, taking up its properties

(defun c:dyn_clone ( / sv_shmnu loop key ent dxf_ent nam_bl typ_ent lay_ent lin_ent col_ent wid_ent sct_ent flag tabl_dxf cmd_clone)
  (setq
    sv_shmnu (getvar "SHORTCUTMENU")
    loop 0
  )
  (setvar "SHORTCUTMENU" 11)
  (while (and (setq key (grread T 4 0)) (not (member key '((2 13) (2 32)))) (/= (car key) 25))
    (cond
      ((and (eq (car key) 3) ent)
        (setq loop (rem (1+ loop) 2))
      )
      (T
        (setq ent (nentselp "" (cadr key)))
      )
    )
    (cond
      ((and ent (zerop loop))
        (if (eq (type (car (last ent))) 'ENAME)
          (setq
            dxf_ent (entget (car (last ent)))
            nam_bl (cdr (assoc 2 dxf_ent))
          )
          (setq dxf_ent (entget (car ent)) nam_bl nil)
        )
        (if (member (cdr (assoc 0 dxf_ent)) '("VERTEX" "ATTRIB"))
          (progn
            (setq dxf_ent (entget (cdr (assoc 330 dxf_ent))))
            (if (assoc 2 dxf_ent) (setq nam_bl (cdr (assoc 2 dxf_ent))))
          )
        )
        (setq
          typ_ent (cdr (assoc 0 dxf_ent))
          lay_ent (cdr (assoc 8 dxf_ent))
          lin_ent (cdr (assoc 6 dxf_ent))
          col_ent (cdr (assoc 62 dxf_ent))
          wid_ent (cdr (assoc 370 dxf_ent))
          sct_ent (cdr (assoc 48 dxf_ent))
        )
        (grtext -2 typ_ent)
      )
    )
  )
  (cond
    ((eq typ_ent "LWPOLYLINE")
      (setq typ_ent "PLINE")
      (if (assoc 43 dxf_ent)
        (setvar "PLINEWID" (cdr (assoc 43 dxf_ent)))
        (setvar "PLINEWID" 
          (if
            (equal 
              (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_ent))
              (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_ent))
            )
            (* 0.5 (+ (cdr (assoc 40 dxf_ent)) (cdr (assoc 40 dxf_ent))))
            0.0
          )
        )
      )
    )
    ((eq typ_ent "POLYLINE")
      (setq flag (rem (cdr (assoc 70 dxf_ent)) 128))
      (cond
        ((< flag 6)
          (setq typ_ent "PLINE")
          (setvar "PLINEWID" 
            (if
              (equal 
                (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_ent))
                (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_ent))
              )
              (* 0.5 (+ (cdr (assoc 40 dxf_ent)) (cdr (assoc 40 dxf_ent))))
              0.0
            )
          )
        )
        ((and (> flag 7) (< flag 14))
          (setq typ_ent "3DPOLY")
        )
        ((> flag 15)
          (setq typ_ent "3DMESH")
        )
      )
    )
    ((or (eq typ_ent "HATCH") (eq typ_ent "SHAPE"))
      (setq nam_bl (cdr (assoc 2 dxf_ent)))
    )
    ((eq typ_ent "DIMENSION")
      (setq nam_bl nil)
      (command "_.-dimstyle" "_restore" (cdr (assoc 3 dxf_ent)))
      (cond
        ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 0)
          (setq typ_ent "DIMLINEAR")
        )
        ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 1)
          (setq typ_ent "DIMALIGNED")
        )
        ((or (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 2) (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 5))
          (setq typ_ent "DIMANGULAR")
        )
        ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 3)
          (setq typ_ent "DIMDIAMETER")
        )
        ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 4)
          (setq typ_ent "DIMRADIUS")
        )
        ((or (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 6) (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 70))
          (setq typ_ent "DIMORDINATE")
        )
        (T (setq typ_ent "DIM"))
      )
    )
    ((eq typ_ent "VIEWPORT")
      (setq typ_ent "VPORTS")
    )
    ((eq typ_ent "3DSOLID")
      (initget 1 "BOîte Sphère CYlindre CÔne BIseau Tore _Box Sphere CYlinder COne Wedge Torus")
      (setq typ_ent (getkword "\n[BOîte/Sphère/CYlindre/CÔne/BIseau/Tore]: "))
    )
    ((or (eq typ_ent "TEXT") (eq typ_ent "MTEXT") (eq typ_ent "ATTDEF"))
      (setvar "TEXTSTYLE" (cdr (assoc 7 dxf_ent)))
      (setvar "TEXTSIZE" (cdr (assoc 40 dxf_ent)))
    )
  )
  (grtext -2 "")
  (setvar "SHORTCUTMENU" sv_shmnu)
  (cond
    (typ_ent
      (setvar "clayer" lay_ent)
      (if lin_ent (setvar "celtype" lin_ent) (setvar "celtype" "ByLayer"))
      (if col_ent (setvar "cecolor" (itoa col_ent)) (setvar "cecolor" "256"))
      (if wid_ent (setvar "celweight" wid_ent) (setvar "celweight" -1))
      (if sct_ent (setvar "celtscale" sct_ent) (setvar "celtscale" 1.0))
      (setq cmd_clone (strcat "_." typ_ent))
      (if nam_bl
        (progn
          (if (and (setq tabl_dxf (tblsearch "BLOCK" nam_bl)) (eq (boole 1 (cdr (assoc 70 tabl_dxf)) 4) 4))
            (command "_.-XREF" "_attach" nam_bl)
            (command cmd_clone nam_bl)
          )
        )
        (command cmd_clone)
      )
    )
    (T (prin1))
  )
)

June 23, 2023

14 hours ago, BIGAL said:

Another way is draw an object with predefined settings layer, linetype, color etc. So would have some shortcuts like B1, B2 to draw beams with correct settings.

We also had a group of lines with predefined set up, and would just paste to the edge of our project so using say Tharwat code they are all available.

Ps saved in a layout not model so would use Ctrl+X to cut then go to model and paste Ctrl+V.

It's a good idea. The problem is that my colleagues don't respect the work order. they do what they want with the layers and the linetypes

June 23, 2023

15 hours ago, Tharwat said:

Give this a shot and let me know.

(defun c:Test (/ *error* sel get lay clr lty scl var val )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (defun *error* (msg)
    (and val (mapcar 'setvar var val))
    (if (and msg (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ "\n*Cancel*"))
      (princ (strcat "\nError => " msg)))
    )
  (if (and (setq sel (car (entsel "\nSelect object to get properties from : ")))
           (setq get (entget sel)
                 lay (cdr (assoc 8 get))
                 )
           (or (/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" lay))))))
               (alert "Object resides on locked layer!. Try again")
               )
           (setq clr (cond ((cdr (assoc 62 get))) (256)))
           (setq lty (cond ((cdr (assoc 06 get))) ("ByLayer")))
           (setq scl (cond ((cdr (assoc 48 get))) (1.0)))
           (setq var '(CECOLOR CELTYPE CLAYER)
                 val (mapcar 'getvar var)
                 )
           (mapcar 'setvar var (list (itoa clr) lty lay))
           )
    (progn
      (vl-cmdf "_.LINE")
      (while (= (getvar 'CMDACTIVE) 1)
        (entmod (append (entget (entlast)) (list (cons 48 scl))))
        (vl-cmdf "\\"))
      )
    )
  (*error* nil)
  (princ)
  )

I like this routine, only I won't necessarily draw a line, I want anything to be able to be drawn with that type of line, color and layer. and that these parameters remain

June 23, 2023

13 hours ago, Tsuky said:

This command allows you to clone a command from an entity already placed in the drawing.
Use:
Run the DYN_CLONE command
Move the cursor over an entity in the drawing: The name of the entity appears in the status bar, instead of the coordinates.
If this entity suits you, validate with a right-click and the appropriate command will be launched, taking up its properties

(defun c:dyn_clone ( / sv_shmnu loop key ent dxf_ent nam_bl typ_ent lay_ent lin_ent col_ent wid_ent sct_ent flag tabl_dxf cmd_clone)
  (setq
    sv_shmnu (getvar "SHORTCUTMENU")
    loop 0
  )
  (setvar "SHORTCUTMENU" 11)
  (while (and (setq key (grread T 4 0)) (not (member key '((2 13) (2 32)))) (/= (car key) 25))
    (cond
      ((and (eq (car key) 3) ent)
        (setq loop (rem (1+ loop) 2))
      )
      (T
        (setq ent (nentselp "" (cadr key)))
      )
    )
    (cond
      ((and ent (zerop loop))
        (if (eq (type (car (last ent))) 'ENAME)
          (setq
            dxf_ent (entget (car (last ent)))
            nam_bl (cdr (assoc 2 dxf_ent))
          )
          (setq dxf_ent (entget (car ent)) nam_bl nil)
        )
        (if (member (cdr (assoc 0 dxf_ent)) '("VERTEX" "ATTRIB"))
          (progn
            (setq dxf_ent (entget (cdr (assoc 330 dxf_ent))))
            (if (assoc 2 dxf_ent) (setq nam_bl (cdr (assoc 2 dxf_ent))))
          )
        )
        (setq
          typ_ent (cdr (assoc 0 dxf_ent))
          lay_ent (cdr (assoc 8 dxf_ent))
          lin_ent (cdr (assoc 6 dxf_ent))
          col_ent (cdr (assoc 62 dxf_ent))
          wid_ent (cdr (assoc 370 dxf_ent))
          sct_ent (cdr (assoc 48 dxf_ent))
        )
        (grtext -2 typ_ent)
      )
    )
  )
  (cond
    ((eq typ_ent "LWPOLYLINE")
      (setq typ_ent "PLINE")
      (if (assoc 43 dxf_ent)
        (setvar "PLINEWID" (cdr (assoc 43 dxf_ent)))
        (setvar "PLINEWID" 
          (if
            (equal 
              (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_ent))
              (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_ent))
            )
            (* 0.5 (+ (cdr (assoc 40 dxf_ent)) (cdr (assoc 40 dxf_ent))))
            0.0
          )
        )
      )
    )
    ((eq typ_ent "POLYLINE")
      (setq flag (rem (cdr (assoc 70 dxf_ent)) 128))
      (cond
        ((< flag 6)
          (setq typ_ent "PLINE")
          (setvar "PLINEWID" 
            (if
              (equal 
                (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_ent))
                (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_ent))
              )
              (* 0.5 (+ (cdr (assoc 40 dxf_ent)) (cdr (assoc 40 dxf_ent))))
              0.0
            )
          )
        )
        ((and (> flag 7) (< flag 14))
          (setq typ_ent "3DPOLY")
        )
        ((> flag 15)
          (setq typ_ent "3DMESH")
        )
      )
    )
    ((or (eq typ_ent "HATCH") (eq typ_ent "SHAPE"))
      (setq nam_bl (cdr (assoc 2 dxf_ent)))
    )
    ((eq typ_ent "DIMENSION")
      (setq nam_bl nil)
      (command "_.-dimstyle" "_restore" (cdr (assoc 3 dxf_ent)))
      (cond
        ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 0)
          (setq typ_ent "DIMLINEAR")
        )
        ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 1)
          (setq typ_ent "DIMALIGNED")
        )
        ((or (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 2) (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 5))
          (setq typ_ent "DIMANGULAR")
        )
        ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 3)
          (setq typ_ent "DIMDIAMETER")
        )
        ((eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 4)
          (setq typ_ent "DIMRADIUS")
        )
        ((or (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 6) (eq (boole 6 (rem (cdr (assoc 70 dxf_ent)) 128) 32) 70))
          (setq typ_ent "DIMORDINATE")
        )
        (T (setq typ_ent "DIM"))
      )
    )
    ((eq typ_ent "VIEWPORT")
      (setq typ_ent "VPORTS")
    )
    ((eq typ_ent "3DSOLID")
      (initget 1 "BOîte Sphère CYlindre CÔne BIseau Tore _Box Sphere CYlinder COne Wedge Torus")
      (setq typ_ent (getkword "\n[BOîte/Sphère/CYlindre/CÔne/BIseau/Tore]: "))
    )
    ((or (eq typ_ent "TEXT") (eq typ_ent "MTEXT") (eq typ_ent "ATTDEF"))
      (setvar "TEXTSTYLE" (cdr (assoc 7 dxf_ent)))
      (setvar "TEXTSIZE" (cdr (assoc 40 dxf_ent)))
    )
  )
  (grtext -2 "")
  (setvar "SHORTCUTMENU" sv_shmnu)
  (cond
    (typ_ent
      (setvar "clayer" lay_ent)
      (if lin_ent (setvar "celtype" lin_ent) (setvar "celtype" "ByLayer"))
      (if col_ent (setvar "cecolor" (itoa col_ent)) (setvar "cecolor" "256"))
      (if wid_ent (setvar "celweight" wid_ent) (setvar "celweight" -1))
      (if sct_ent (setvar "celtscale" sct_ent) (setvar "celtscale" 1.0))
      (setq cmd_clone (strcat "_." typ_ent))
      (if nam_bl
        (progn
          (if (and (setq tabl_dxf (tblsearch "BLOCK" nam_bl)) (eq (boole 1 (cdr (assoc 70 tabl_dxf)) 4) 4))
            (command "_.-XREF" "_attach" nam_bl)
            (command cmd_clone nam_bl)
          )
        )
        (command cmd_clone)
      )
    )
    (T (prin1))
  )
)

thank you. I ran it but I didn't know how to use it

June 23, 2023

16 minutes ago, leonucadomi said:

I like this routine, only I won't necessarily draw a line, I want anything to be able to be drawn with that type of line, color and layer. and that these parameters remain

I did not see your 'like' !.

June 23, 2023

Why not just use ADDSELECTED command and Cancel when it starts to draw... @Dahzeealready suggested it, but you neglected it...

June 23, 2023

38 minutes ago, marko_ribar said:

Why not just use ADDSELECTED command and Cancel when it starts to draw... @Dahzeealready suggested it, but you neglected it...

if i use that command and select a line (example) I can only draw a line.

if i use that command and select a circle (example) I can only draw a circle.

and what I want is...

select a line (example) I can only draw a line, circle, arc or polyline

with the same object properties (color,linetype,layer).

and so that those parameters remain pre-established

until I select another (different) line and can do the same.

something similar to LAYMCUR

June 23, 2023

Quote

@leonucadomi

thank you. I ran it but I didn't know how to use it

Run the command
With the cursor wander over an entity already drawn.
When the cursor passes over an entity its type appears on the status bar (instead of the display of coordinates)
If it is this type of entity that you want to reproduce, validate with the right-click
The appropriate drawing command will then be launched with the same properties.
I can't explain anymore... Launch and watch the taskbar.

June 23, 2023

No, it won't work with ADDSELECTED + Cancel, but I've prepared something for you :

(defun c:cc ( / LM:cecolorfromentity LM:true->rgb KGA_Sys_Transparency_Num_To_Perc KGA_Sys_Transparency_Perc_To_Num s e ex lay )

  ;; CECOLOR from Entity  -  Lee Mac

  (defun LM:cecolorfromentity ( ent / enx tmp )
    (setvar 'cecolor
      (cond
        ( (cdr (assoc 430 (setq enx (entget ent)))) )
        ( (setq tmp (cdr (assoc 420 enx)))
          (apply 'strcat (mapcar '(lambda ( a b ) (strcat a (itoa b))) '("RGB:" "," ",") (LM:true->rgb tmp)))
        )
        ( (null (setq tmp (cdr (assoc 62 enx))))
          "BYLAYER"
        )
        ( (zerop tmp)
          "BYBLOCK"
        )
        ( (itoa tmp) )
      )
    )
  )

  ;; True -> RGB  -  Lee Mac
  ;; Args: c - [int] True Colour

  (defun LM:true->rgb ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
  )

  ; (KGA_Sys_Transparency_Num_To_Perc 33554661) => 0.1 (= 10%)
  ; (KGA_Sys_Transparency_Num_To_Perc (cdr (assoc 440 (entget (car (entsel))))))
  (defun KGA_Sys_Transparency_Num_To_Perc ( num )
    (* 0.01 (fix (/ (- 33554687 num) 2.55)))
  )
   
  ; (KGA_Sys_Transparency_Perc_To_Num 0.1) => 33554661
  (defun KGA_Sys_Transparency_Perc_To_Num ( perc )
    (fix (- 33554687 (* perc 255)))
  )

  (prompt "\nPick source entity with desired layer, linetype, ltscale, lweight, transparency and color for current new usage...")
  (setq s (ssget "_+.:E:S"))
  (while (not s)
    (prompt "\nMissed... Try picking source entity with desired layer, linetype, ltscale, lweight, transparency and color for current new usage again...")
    (setq s (ssget "_+.:E:S"))
  )
  (if (/= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (setq lay (cdr (assoc 8 (setq ex (entget (setq e (ssname s 0))))))))))))
    (setvar 'clayer lay)
  )
  (if (assoc 6 ex)
    (setvar 'celtype (cdr (assoc 6 ex)))
  )
  (if (assoc 48 ex)
    (setvar 'celtscale (cdr (assoc 48 ex)))
  )
  (if (assoc 370 ex)
    (setvar 'celweight (cdr (assoc 370 ex)))
  )
  (if (assoc 440 ex)
    (setvar 'cetransparency (* 100 (KGA_Sys_Transparency_Num_To_Perc (cdr (assoc 440 ex)))))
    (setvar 'cetransparency 0)
  )
  (LM:cecolorfromentity e)
  (princ)
)

HTH.

M.R.

Edited June 24, 2023 by marko_ribar

June 26, 2023

On 6/23/2023 at 3:25 PM, marko_ribar said:

No, it won't work with ADDSELECTED + Cancel, but I've prepared something for you :

(defun c:cc ( / LM:cecolorfromentity LM:true->rgb KGA_Sys_Transparency_Num_To_Perc KGA_Sys_Transparency_Perc_To_Num s e ex lay )

  ;; CECOLOR from Entity  -  Lee Mac

  (defun LM:cecolorfromentity ( ent / enx tmp )
    (setvar 'cecolor
      (cond
        ( (cdr (assoc 430 (setq enx (entget ent)))) )
        ( (setq tmp (cdr (assoc 420 enx)))
          (apply 'strcat (mapcar '(lambda ( a b ) (strcat a (itoa b))) '("RGB:" "," ",") (LM:true->rgb tmp)))
        )
        ( (null (setq tmp (cdr (assoc 62 enx))))
          "BYLAYER"
        )
        ( (zerop tmp)
          "BYBLOCK"
        )
        ( (itoa tmp) )
      )
    )
  )

  ;; True -> RGB  -  Lee Mac
  ;; Args: c - [int] True Colour

  (defun LM:true->rgb ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
  )

  ; (KGA_Sys_Transparency_Num_To_Perc 33554661) => 0.1 (= 10%)
  ; (KGA_Sys_Transparency_Num_To_Perc (cdr (assoc 440 (entget (car (entsel))))))
  (defun KGA_Sys_Transparency_Num_To_Perc ( num )
    (* 0.01 (fix (/ (- 33554687 num) 2.55)))
  )
   
  ; (KGA_Sys_Transparency_Perc_To_Num 0.1) => 33554661
  (defun KGA_Sys_Transparency_Perc_To_Num ( perc )
    (fix (- 33554687 (* perc 255)))
  )

  (prompt "\nPick source entity with desired layer, linetype, ltscale, lweight, transparency and color for current new usage...")
  (setq s (ssget "_+.:E:S"))
  (while (not s)
    (prompt "\nMissed... Try picking source entity with desired layer, linetype, ltscale, lweight, transparency and color for current new usage again...")
    (setq s (ssget "_+.:E:S"))
  )
  (if (/= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (setq lay (cdr (assoc 8 (setq ex (entget (setq e (ssname s 0))))))))))))
    (setvar 'clayer lay)
  )
  (if (assoc 6 ex)
    (setvar 'celtype (cdr (assoc 6 ex)))
  )
  (if (assoc 48 ex)
    (setvar 'celtscale (cdr (assoc 48 ex)))
  )
  (if (assoc 370 ex)
    (setvar 'celweight (cdr (assoc 370 ex)))
  )
  (if (assoc 440 ex)
    (setvar 'cetransparency (* 100 (KGA_Sys_Transparency_Num_To_Perc (cdr (assoc 440 ex)))))
    (setvar 'cetransparency 0)
  )
  (LM:cecolorfromentity e)
  (princ)
)

HTH.

M.R.

brilliant. It's exactly what I need. thank you

June 26, 2023

On 6/23/2023 at 3:25 PM, marko_ribar said:

No, it won't work with ADDSELECTED + Cancel, but I've prepared something for you :

(defun c:cc ( / LM:cecolorfromentity LM:true->rgb KGA_Sys_Transparency_Num_To_Perc KGA_Sys_Transparency_Perc_To_Num s e ex lay )

  ;; CECOLOR from Entity  -  Lee Mac

  (defun LM:cecolorfromentity ( ent / enx tmp )
    (setvar 'cecolor
      (cond
        ( (cdr (assoc 430 (setq enx (entget ent)))) )
        ( (setq tmp (cdr (assoc 420 enx)))
          (apply 'strcat (mapcar '(lambda ( a b ) (strcat a (itoa b))) '("RGB:" "," ",") (LM:true->rgb tmp)))
        )
        ( (null (setq tmp (cdr (assoc 62 enx))))
          "BYLAYER"
        )
        ( (zerop tmp)
          "BYBLOCK"
        )
        ( (itoa tmp) )
      )
    )
  )

  ;; True -> RGB  -  Lee Mac
  ;; Args: c - [int] True Colour

  (defun LM:true->rgb ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
  )

  ; (KGA_Sys_Transparency_Num_To_Perc 33554661) => 0.1 (= 10%)
  ; (KGA_Sys_Transparency_Num_To_Perc (cdr (assoc 440 (entget (car (entsel))))))
  (defun KGA_Sys_Transparency_Num_To_Perc ( num )
    (* 0.01 (fix (/ (- 33554687 num) 2.55)))
  )
   
  ; (KGA_Sys_Transparency_Perc_To_Num 0.1) => 33554661
  (defun KGA_Sys_Transparency_Perc_To_Num ( perc )
    (fix (- 33554687 (* perc 255)))
  )

  (prompt "\nPick source entity with desired layer, linetype, ltscale, lweight, transparency and color for current new usage...")
  (setq s (ssget "_+.:E:S"))
  (while (not s)
    (prompt "\nMissed... Try picking source entity with desired layer, linetype, ltscale, lweight, transparency and color for current new usage again...")
    (setq s (ssget "_+.:E:S"))
  )
  (if (/= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (setq lay (cdr (assoc 8 (setq ex (entget (setq e (ssname s 0))))))))))))
    (setvar 'clayer lay)
  )
  (if (assoc 6 ex)
    (setvar 'celtype (cdr (assoc 6 ex)))
  )
  (if (assoc 48 ex)
    (setvar 'celtscale (cdr (assoc 48 ex)))
  )
  (if (assoc 370 ex)
    (setvar 'celweight (cdr (assoc 370 ex)))
  )
  (if (assoc 440 ex)
    (setvar 'cetransparency (* 100 (KGA_Sys_Transparency_Num_To_Perc (cdr (assoc 440 ex)))))
    (setvar 'cetransparency 0)
  )
  (LM:cecolorfromentity e)
  (princ)
)

HTH.

M.R.

I already tried it and it works, but it has a problem

if the origin line is "bylayer"

does not change the linetype

June 27, 2023

Somewhere had create a object based on pick which is what you want, try this can add more properties.

; matches pick object for next command plus layer
; created 2011
; sorry no author

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

Sign In

make current line properties routine lsp

Recommended Posts

leonucadomi

Dahzee

leonucadomi

CyberAngel

leonucadomi

Tharwat

BIGAL

Tsuky

leonucadomi

leonucadomi

leonucadomi

Tharwat

marko_ribar

leonucadomi

Tsuky

marko_ribar

leonucadomi

leonucadomi

BIGAL

Join the conversation

Tutorials

Forums

Activity