Jump to content

simple dxf compare

exceed

By exceed
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

exceed Proficient

exceed

Posted
Posted (edited) 
; dxf compare
             
(defun c:dc (/ e a b ss1 ss2)
  (setq a "") 
  (setq b "")
  (princ "\n select 1st object for compare")
  (if (setq ss1 (ssget "+.:E:S" ))
    (progn
      (foreach ent
        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
        (setq a (entget ent '( "*")))
      );end of foreach
      (princ "\n select 2nd object for compare")
      (if (setq ss2 (ssget "+.:E:S" ))
        (progn 
          (foreach ent
            (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2)))
            (setq b (entget ent '( "*")))
          );end of foreach
          (setq al (length a))
          (setq bl (length b))
          (setq atype (cdr (assoc 0 a)))
          (setq btype (cdr (assoc 0 b)))
          (setq index 0)
          (setq aaa '())
          (setq bbb '())
          (repeat al
             (setq aa (nth index a))
             (if (not (member aa b))
                (progn 
                  (setq aaa (cons aa aaa))
                );end of progn
             );end of if
             (setq index (+ index 1))
          );end of repeat
          (setq aaa (reverse aaa))
          (setq index 0)
          (repeat bl
             (setq bb (nth index b))
             (if (not (member bb a))
                (progn 
                  (setq bbb (cons bb bbb))
                );end of progn
             );end of if
             (setq index (+ index 1))
          );end of repeat
          (setq bbb (reverse bbb))
          (setq aaal (length aaa))
          (setq bbbl (length bbb))
          (cond 
            ((= aaal bbbl) (setq cccl aaal))
            ((> aaal bbbl) (setq cccl aaal))
            ((< aaal bbbl) (setq cccl bbbl))
          );end of cond
          (setq aindex 0)
          (setq bindex 0)
          (repeat (+ aaal bbbl)
             (setq aaaa (nth aindex aaa))
             (setq bbbb (nth bindex bbb))
             (setq r '())

             (if (= aaaa nil) (setq aaaa (list 99999 "empty")))
             (if (= bbbb nil) (setq bbbb (list 99999 "empty")))
             (setq agap (- 30 (strlen (vl-princ-to-string aaaa)) ) )
             (setq agapstr "")
             (cond 
               ((< agap 0) (setq agap 0))
               ((= agap 0) (setq agap 0))
               ((> agap 0) 
                 (repeat agap 
                   (setq agapstr (strcat "_" agapstr))
                 )
               )
             )
             (setq bgap (- 30 (strlen (vl-princ-to-string bbbb)) ) )
             (setq bgapstr "")
             (cond 
               ((< bgap 0) (setq bgap 0))
               ((= bgap 0) (setq bgap 0))
               ((> bgap 0) 
                 (repeat bgap
                   (setq bgapstr (strcat "_" bgapstr))
                 )
               )
             )

             (cond
                ( (= (car aaaa) (car bbbb))
                  (progn
                    (if (and (= (car aaaa) 99999) (= (car bbbb) 99999))
                        (progn)
                        (progn 
                          (setq r (list (strcat (vl-princ-to-string aaaa) agapstr) "\t \t" (strcat (vl-princ-to-string bbbb) bgapstr)))
                          (princ "\n")
                          (princ r)
                          (setq aindex (+ aindex 1))
                          (setq bindex (+ bindex 1))
                        );end of progn
                     );enf of if
                  )
                )
                ((< (car aaaa) (car bbbb))
                   (progn
                     (setq r (list (strcat (vl-princ-to-string aaaa) agapstr) "\t \t" "______________________________"))
                     (princ "\n")
                     (princ r)
                     (setq aindex (+ aindex 1))
                   )
                 )
                ((> (car aaaa) (car bbbb))
                   (progn
                     (setq r (list "______________________________" "\t \t" (strcat (vl-princ-to-string bbbb) bgapstr)))
                     (princ "\n")
                     (princ r)
                     (setq bindex (+ bindex 1))
                   )
                 )
               );end of cond

          );end of repeat
        );end of progn
        (progn 
          ;(princ "\n please re-select")
          ;(c:dc)
        );end of progn
      );end of if
    );end of progn
    (progn 
      ;(princ "\n please re-select")
      ;(c:dc)
    )
  )




  ;(textscr)
  (princ)
)
;;---------------------------

 

 

I'm tired of playing Magic Eye. It's annoying to even enter a text compare site. So I made this.

of course, except for me beginner, don't seem to need this.

 

input "dc" then select 2 single object.

it compare dxf field. output only different line. 

 

like below

(2 lines) 

((-1 . <ENTITY NAME: d9dcabc0>)                  (-1 . <ENTITY NAME: d9dcabf0>))
((5 . 27B)_____________________                  (5 . 27D)_____________________)
((10 23.563 -2.10375)__________                  (10 19.0003 -6.19297)_________)
((10 10.8649 -3.82553)_________                  (10 26.3179 -6.7956)__________)

 

(2 polylilnes) 

((-1 . <ENTITY NAME: d9dcac08>)                  (-1 . <ENTITY NAME: d9dcac20>))
((5 . 27E)_____________________                  (5 . 27F)_____________________)
((90 . 4)______________________                  (90 . 3)______________________)
((70 . 1)______________________                  (70 . 0)______________________)
((10 31.823 -0.939268)_________                  (10 38.5724 -6.03573)_________)
((10 36.9195 -0.939268)________                  (10 26.8643 -10.168)__________)
((10 36.9195 -3.62524)_________                  (10 35.7486 -13.0606)_________)
((10 31.823 -3.62524)__________                  ______________________________)

 

(hatch and circle) 

((0 . HATCH)___________________                  (0 . CIRCLE)__________________)
((5 . 27A)_____________________                  (5 . 277)_____________________)
((100 . AcDbHatch)_____________                  (100 . AcDbCircle)____________)
((10 0.0 0.0 0.0)______________                  (10 8.84185 5.73033 0.0)______)
((2 . ANSI31)__________________                  ______________________________)
(______________________________                  (40 . 1.37)___________________)
((70 . 0)______________________                  ______________________________)
((71 . 0)______________________                  ______________________________)
((91 . 1)______________________                  ______________________________)
((92 . 1)______________________                  ______________________________)
((93 . 1)______________________                  ______________________________)
((72 . 3)______________________                  ______________________________)
((10 9.61665 -0.2098 0.0)______                  ______________________________)
((11 1.42502 0.0 0.0)__________                  ______________________________)
((40 . 1.0)____________________                  ______________________________)
((50 . 0.0)____________________                  ______________________________)
((51 . 6.28319)________________                  ______________________________)
((73 . 1)______________________                  ______________________________)
((97 . 0)______________________                  ______________________________)
((75 . 1)______________________                  ______________________________)
((76 . 1)______________________                  ______________________________)
((52 . 0.0)____________________                  ______________________________)
((41 . 1.0)____________________                  ______________________________)
((77 . 0)______________________                  ______________________________)
((78 . 1)______________________                  ______________________________)
((53 . 0.785398)_______________                  ______________________________)
((43 . 0.0)____________________                  ______________________________)
((44 . 0.0)____________________                  ______________________________)
((45 . -0.0883883)_____________                  ______________________________)
((46 . 0.0883883)______________                  ______________________________)
((79 . 0)______________________                  ______________________________)
((98 . 1)______________________                  ______________________________)
((10 0.0 0.0 0.0)______________                  ______________________________)
((-3 (HATCHBACKGROUNDCOLOR (1071 . -939524096) (1000 . ) (1000 . )) (ACAD (1010 0.0 0.0 0.0)))           ______________________________)

 

Line -3 is abandoned for sorting purposes.

 

because this is modified based on the code that selects many things.

It can simply get the list with (setq a (entget(car(entsel))))

 

 

 

I try this link for vlax-dump-object compare also. but I failed that. just return nil value.

https://www.theswamp.org/index.php?topic=52409.msg573540#msg573540

Edited by exceed
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

You can sort of get at vl properties, you would need a list of what you want to look for.

eg Circle has radius and Center point

(vlax-property-available-p obj 'radius) returns true for a circle or arc. 

So a list may start with ("objectName" "Layer" and so on "Radius" "Length" "Circumference" ..........

 

 

Edited by BIGAL
  • Like 1
Link to comment
Share on other sites
exceed Proficient

exceed

Posted
  • Author
Posted (edited)
8 hours ago, BIGAL said:

You can sort of get at vl properties, you would need a list of what you want to look for.

eg Circle has radius and Center point

(vlax-property-available-p obj 'radius) returns true for a circle or arc. 

So a list may start with ("objectName" "Layer" and so on "Radius" "Length" "Circumference" ..........

 

 

  

(defun c:test ( / ent a *error* al index aa aaa )

  ;error control
    (defun *error* ( msg )

        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))

        )
        (princ)
    )

 (setq ent (car (entsel)))
 (setq a (f:vl-property-available ent))
 (setq al (length a))
 (setq index 0)
 (princ "\n a - ")
 (princ a)
 (princ "\n al - ")
 (princ al)
 (repeat al
   (setq aa (nth index a));(vl-princ-to-string (nth index a)))
   (princ "\n ")
   (princ (+ index 1))
   (princ " ")
   (princ aa)
   (if (/= aa nil) ; (and (/= aa "COORDINATE") (/= aa "NAME") (/= aa "KNOTPARAMETERIZATION") (/= aa "IMAGEFILE") (/= aa "SPLINEFRAME") (/= aa "DEGREE2"))
     (progn
       (if (setq aaa (vl-princ-to-string (vlax-get (vlax-ename->vla-object ent) aa)))
         (progn      
           (princ " - ")
           (princ aaa)
         );end of progn
       );end of if
     );end of progn
   );end of if
   (setq index (+ index 1))
 )

 (princ)
)

;https://www.thecadforums.com/threads/vlax-dump-object.27977/

(defun f:vla-getlist ()
(cond
(*vla-getlist*)
((setq *vla-getlist* (mapcar (function (lambda (x) (substr x 9)))
(vl-remove-if-not (function (lambda (x) (wcmatch (strcase x) "VLA-GET-*"))) (atoms-family 1))
)
);setq
)
)
)

(defun f:vl-property-available (en)
(setq en (f:enx en))
(vl-remove-if-not (function (lambda (x) (vlax-property-available-p en x)))
(f:vla-getlist)
)
)

(defun f:vla-methodlist ()
(cond
(*vla-methodlist*)
((setq *vla-methodlist* (mapcar (function (lambda (x) (substr x 5)))
(vl-remove-if-not (function (lambda (x)
(and
(wcmatch (strcase x) "VLA-*")
(not (wcmatch (strcase x) "VLA-GET-*,VLA-PUT-*"))
);and
)
)
(atoms-family 1)
)
)
);setq
)
);cond
)



(defun f:vl-method-applicable (en)
(setq en (f:enx en))
(vl-remove-if-not (function (lambda (x) (vlax-method-applicable-p en x)))
(f:vla-methodlist)
)
)

(defun f:enx (en)
(if (= (type en) 'ENAME)
(vlax-ename->vla-object en)
en
)
)

 

Thank you for answer.

I found modules in this link ( https://www.thecadforums.com/threads/vlax-dump-object.27977/ )

to make it easier to use as you said (vlax-property-available-p obj 'radius).

 

I can get with vla-get as an 'atom' and outputting the list,

and then use that list with (vla-get object variable).

 

I had some success in extracting the list of properties (with lines, circles ... not polyline)

However, even in the available state, if the corresponding value is empty,

an error occurs and the routine stops. (wrong independent variable count or something different. )

 

Even if I wanted to skip an empty value with if, it was of no use because an error occurred the moment I called it.

 

So I tried vl-catch-all-apply, and error-p, like below 

 (if (vl-catch-all-error-p (setq test (vl-catch-all-apply 'vla-get obj aa)))
                (progn 
                   ;(princ (vl-catch-all-error-message test)) ;if error msg
                   (princ " - empty ")
                );end of progn
                (progn 
                   (setq aaa (vl-princ-to-string (vlax-get obj aa)))
                   (princ " - ")
                   (princ aaa)
                );end of progn
 );end of if

but (vl-catch-all-apply 'vla-get obj aa) is not correct maybe, this is my step now.😅

 

 

Edited by exceed
Link to comment
Share on other sites
exceed Proficient

exceed

Posted
  • Author
Posted (edited)
1 hour ago, lido said:

@exceed

 

Syntax incorrect of (vl-catch-all-apply 'vla-get obj aa).

Try (vl-catch-all-apply (function vla-get) (list obj aa))

 

great! that is what I find and misunderstood!!

so, I improve this by your help

command : vda = vlax-dump-object alternative

command : vdc = vlax-dump-object compare

  

;; dump - 2022.03.17 exceed
;; dc - dxf compare 
;; vda - vlax-dump-object alternative, this will make list not only command prompt output
;; vdc - vlax-dump-object compare

(defun c:dc (/ e a b ss1 ss2)
  (setq a "") 
  (setq b "")
  (princ "\n select 1st object for compare")
  (if (setq ss1 (ssget "+.:E:S" ))
    (progn
      (foreach ent
        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
        (setq a (entget ent '( "*")))
      );end of foreach
      (princ "\n select 2nd object for compare")
      (if (setq ss2 (ssget "+.:E:S" ))
        (progn 
          (foreach ent
            (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2)))
            (setq b (entget ent '( "*")))
          );end of foreach
          (setq al (length a))
          (setq bl (length b))
          (setq atype (cdr (assoc 0 a)))
          (setq btype (cdr (assoc 0 b)))
          (setq index 0)
          (setq aaa '())
          (setq bbb '())
          (repeat al
             (setq aa (nth index a))
             (if (not (member aa b))
                (progn 
                  (setq aaa (cons aa aaa))
                );end of progn
             );end of if
             (setq index (+ index 1))
          );end of repeat
          (setq aaa (reverse aaa))
          (setq index 0)
          (repeat bl
             (setq bb (nth index b))
             (if (not (member bb a))
                (progn 
                  (setq bbb (cons bb bbb))
                );end of progn
             );end of if
             (setq index (+ index 1))
          );end of repeat
          (setq bbb (reverse bbb))
          (setq aaal (length aaa))
          (setq bbbl (length bbb))
          (cond 
            ((= aaal bbbl) (setq cccl aaal))
            ((> aaal bbbl) (setq cccl aaal))
            ((< aaal bbbl) (setq cccl bbbl))
          );end of cond
          (setq aindex 0)
          (setq bindex 0)
          (repeat (+ aaal bbbl)
             (setq aaaa (nth aindex aaa))
             (setq bbbb (nth bindex bbb))
             (setq r '())

             (if (= aaaa nil) (setq aaaa (list 99999 "empty")))
             (if (= bbbb nil) (setq bbbb (list 99999 "empty")))
             (setq agap (- 30 (strlen (vl-princ-to-string aaaa)) ) )
             (setq agapstr "")
             (cond 
               ((< agap 0) (setq agap 0))
               ((= agap 0) (setq agap 0))
               ((> agap 0) 
                 (repeat agap 
                   (setq agapstr (strcat "_" agapstr))
                 )
               )
             )
             (setq bgap (- 30 (strlen (vl-princ-to-string bbbb)) ) )
             (setq bgapstr "")
             (cond 
               ((< bgap 0) (setq bgap 0))
               ((= bgap 0) (setq bgap 0))
               ((> bgap 0) 
                 (repeat bgap
                   (setq bgapstr (strcat "_" bgapstr))
                 )
               )
             )

             (cond
                ( (= (car aaaa) (car bbbb))
                  (progn
                    (if (and (= (car aaaa) 99999) (= (car bbbb) 99999))
                        (progn)
                        (progn 
                          (setq r (list (strcat (vl-princ-to-string aaaa) agapstr) "\t \t" (strcat (vl-princ-to-string bbbb) bgapstr)))
                          (princ "\n")
                          (princ r)
                          (setq aindex (+ aindex 1))
                          (setq bindex (+ bindex 1))
                        );end of progn
                     );enf of if
                  )
                )
                ((< (car aaaa) (car bbbb))
                   (progn
                     (setq r (list (strcat (vl-princ-to-string aaaa) agapstr) "\t \t" "______________________________"))
                     (princ "\n")
                     (princ r)
                     (setq aindex (+ aindex 1))
                   )
                 )
                ((> (car aaaa) (car bbbb))
                   (progn
                     (setq r (list "______________________________" "\t \t" (strcat (vl-princ-to-string bbbb) bgapstr)))
                     (princ "\n")
                     (princ r)
                     (setq bindex (+ bindex 1))
                   )
                 )
               );end of cond

          );end of repeat
        );end of progn
        (progn 
          ;(princ "\n please re-select")
          ;(c:dc)
        );end of progn
      );end of if
    );end of progn
    (progn 
      ;(princ "\n please re-select")
      ;(c:dc)
    )
  )




  ;(textscr)
  (princ)
)


;; https://www.thecadforums.com/threads/vlax-dump-object.27977/

(defun f:vla-getlist ()
(cond
(*vla-getlist*)
((setq *vla-getlist* (mapcar (function (lambda (x) (substr x 9)))
(vl-remove-if-not (function (lambda (x) (wcmatch (strcase x) "VLA-GET-*"))) (atoms-family 1))
)
);setq
)
)
)

(defun f:vl-property-available (en)
(setq en (f:enx en))
(vl-remove-if-not (function (lambda (x) (vlax-property-available-p en x)))
(f:vla-getlist)
)
)

(defun f:vla-methodlist ()
(cond
(*vla-methodlist*)
((setq *vla-methodlist* (mapcar (function (lambda (x) (substr x 5)))
(vl-remove-if-not (function (lambda (x)
(and
(wcmatch (strcase x) "VLA-*")
(not (wcmatch (strcase x) "VLA-GET-*,VLA-PUT-*"))
);and
)
)
(atoms-family 1)
)
)
);setq
)
);cond
)



(defun f:vl-method-applicable (en)
(setq en (f:enx en))
(vl-remove-if-not (function (lambda (x) (vlax-method-applicable-p en x)))
(f:vla-methodlist)
)
)

(defun f:enx (en)
(if (= (type en) 'ENAME)
(vlax-ename->vla-object en)
en
)
)


(defun c:vdc ( / ent a *error* al index aa aaa )
  ;error control
    (defun *error* ( msg )
        ;(LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (princ)
    )
(princ "\n select 1st object for compare")
(if (setq ent (car (entsel)))
 (progn
 (setq astacklist '())
 (setq aget (f:vl-property-available ent))
 (setq aget (LM:Unique aget))
 (setq al (length aget))
 (setq index 0)
 ;(princ "\n a - ")
 ;(princ a)
 ;(princ "\n al - ")
 ;(princ al)
 (repeat al
   (setq aa (nth index aget)) 
   (setq aaa "")
   ;(princ "\n ")
   ;(princ (+ index 1))
   ;(princ " ")
   ;(princ aa)
   (setq obj (vlax-ename->vla-object ent))
   (if (vl-catch-all-error-p (setq test (vl-catch-all-apply (function vlax-get) (list obj aa))))
                (progn 
                   ;(princ (vl-catch-all-error-message test)) ;print error message
                   (setq aaa " ")
                   ;(princ " - ")
                   ;(princ aaa)
                );end of progn
                (progn 
                   (setq aaa (vl-princ-to-string (vlax-get obj aa)))
                   ;(princ " - ")
                   ;(princ aaa)
                 );end of progn
   );end of if
   (setq alist '())
   (setq alist (list (strcat (substr aa 1 1) (strcase (substr aa 2) t)) aaa))
   (setq astacklist (cons alist astacklist))
   (setq index (+ index 1))
 )
 (setq a (reverse astacklist))
 (princ "\n select 2nd object for compare")

(if (setq ent2 (car (entsel)))
 (progn
 (setq bstacklist '())
 (setq bget (f:vl-property-available ent2))
 (setq bget (LM:Unique bget))
 (setq bl (length bget))
 (setq index 0)
 ;(princ "\n b - ")
 ;(princ b)
 ;(princ "\n bl - ")
 ;(princ bl)
 (repeat bl
   (setq bb (nth index bget)) 
   (setq bbb "")
   ;(princ "\n ")
   ;(princ (+ index 1))
   ;(princ " ")
   ;(princ bb)
   (setq obj2 (vlax-ename->vla-object ent2))
   (if (vl-catch-all-error-p (setq test2 (vl-catch-all-apply (function vlax-get) (list obj2 bb))))
                (progn 
                   ;(princ (vl-catch-all-error-message test2)) ;print error message
                   (setq bbb " ")
                   ;(princ " - ")
                   ;(princ bbb)
                );end of progn
                (progn 
                   (setq bbb (vl-princ-to-string (vlax-get obj2 bb)))
                   ;(princ " - ")
                   ;(princ bbb)
                 );end of progn
   );end of if
   (setq blist '())
   (setq blist (list (strcat (substr bb 1 1) (strcase (substr bb 2) t)) bbb))
   (setq bstacklist (cons blist bstacklist))
   (setq index (+ index 1))
 )
 (setq b (reverse bstacklist))


 (setq a (vl-sort a (function (lambda (x1 x2)(< (car x1) (car x2))) ) ))
 (setq b (vl-sort b (function (lambda (x1 x2)(< (car x1) (car x2))) ) ))

          (setq al (length a))
          (setq bl (length b))
          (setq atype (cdr (assoc 0 a)))
          (setq btype (cdr (assoc 0 b)))
          (setq index 0)
          (setq aaa '())
          (setq bbb '())
          (repeat al
             (setq aa (nth index a))
             (if (not (member aa b))
                (progn 
                  (setq aaa (cons aa aaa))
                );end of progn
             );end of if
             (setq index (+ index 1))
          );end of repeat
          (setq aaa (reverse aaa))
          (setq index 0)
          (repeat bl
             (setq bb (nth index b))
             (if (not (member bb a))
                (progn 
                  (setq bbb (cons bb bbb))
                );end of progn
             );end of if
             (setq index (+ index 1))
          );end of repeat
          (setq bbb (reverse bbb))
          (setq aaal (length aaa))
          (setq bbbl (length bbb))
          (cond 
            ((= aaal bbbl) (setq cccl aaal))
            ((> aaal bbbl) (setq cccl aaal))
            ((< aaal bbbl) (setq cccl bbbl))
          );end of cond
          (setq aindex 0)
          (setq bindex 0)
          (repeat (+ aaal bbbl)
             (setq aaaa (nth aindex aaa))
             (setq bbbb (nth bindex bbb))
             (setq r '())

             (if (= aaaa nil) (setq aaaa (list "ZZZZZ" "empty")))
             (if (= bbbb nil) (setq bbbb (list "ZZZZZ" "empty")))
             (setq agap (- 60 (strlen (vl-princ-to-string aaaa)) ) )
             (setq agapstr "")
             (cond 
               ((< agap 0) (setq agap 0))
               ((= agap 0) (setq agap 0))
               ((> agap 0) 
                 (repeat agap 
                   (setq agapstr (strcat "_" agapstr))
                 )
               )
             )
             (setq bgap (- 60 (strlen (vl-princ-to-string bbbb)) ) )
             (setq bgapstr "")
             (cond 
               ((< bgap 0) (setq bgap 0))
               ((= bgap 0) (setq bgap 0))
               ((> bgap 0) 
                 (repeat bgap
                   (setq bgapstr (strcat "_" bgapstr))
                 )
               )
             )

             (cond
                ( (= (car aaaa) (car bbbb))
                  (progn
                    (if (and (= (car aaaa) "ZZZZZ") (= (car bbbb) "ZZZZZ"))
                        (progn)
                        (progn 
                          (setq r (list aaaa "\t \t" bbbb))
                          (princ "\n ; ")
                          (princ (car (car r)))
                          (princ " = ")
                          (princ (cadr (car r)))
                          (princ agapstr)
                          (princ (cadr r))
                          (princ (car (caddr r)))
                          (princ " = ; ")
                          (princ (cadr (caddr r)))
                          (princ bgapstr)
                          (setq aindex (+ aindex 1))
                          (setq bindex (+ bindex 1))
                        );end of progn
                     );enf of if
                  )
                )
                ((< (car aaaa) (car bbbb))
                   (progn
                     (setq r (list aaaa "\t \t" "____________________________________________________________"))
                          (princ "\n ; ")
                          (princ (car (car r)))
                          (princ " = ")
                          (princ (cadr (car r)))
                          (princ agapstr)
                          (princ (cadr r))
                          (princ (caddr r))
                     (setq aindex (+ aindex 1))
                   )
                 )
                ((> (car aaaa) (car bbbb))
                   (progn
                     (setq r (list "____________________________________________________________" "\t \t" bbbb))
                          (princ "\n ; ")
                          (princ (car r))
                          (princ (cadr r))
                          (princ (car (caddr r)))
                          (princ " = ")
                          (princ (cadr (caddr r)))
                          (princ bgapstr)
                     (setq bindex (+ bindex 1))
                   )
                 )
               );end of cond

          );end of repeat
        );end of progn
        (progn 
          ;(princ "\n please re-select")
          ;(c:dc)
        );end of progn
      );end of if
    );end of progn
    (progn 
      ;(princ "\n please re-select")
      ;(c:dc)
    )
  )
 (princ)
)



; vl-dump-object alternative
(defun c:vda ( / ent a *error* al index aa aaa )
  ;error control
    (defun *error* ( msg )
        ;(LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (princ)
    )
(princ "\n select object for dump")
(setq a '())
(setq astacklist '())
(if (setq ent (car (entsel)))
 (progn
 (setq aget (f:vl-property-available ent))
 (setq aget (LM:Unique aget))
 (setq al (length aget))
 (setq index 0)
 ;(princ "\n a - ")
 ;(princ a)
 ;(princ "\n al - ")
 ;(princ al)
 (repeat al
   (setq aa (nth index aget)) 
   (setq aaa "")
   ;(princ "\n ")
   ;(princ (+ index 1))
   ;(princ " ")
   ;(princ aa)
   (setq obj (vlax-ename->vla-object ent))
   (if (vl-catch-all-error-p (setq test (vl-catch-all-apply (function vlax-get) (list obj aa))))
                (progn 
                   ;(princ (vl-catch-all-error-message test)) ;print error message
                   (setq aaa " ")
                   ;(princ " - ")
                   ;(princ aaa)
                );end of progn
                (progn 
                   (setq aaa (vl-princ-to-string (vlax-get obj aa)))
                   ;(princ " - ")
                   ;(princ aaa)
                 );end of progn
   );end of if
   (setq alist '())
   (setq alist (list (strcat (substr aa 1 1) (strcase (substr aa 2) t)) aaa))
   (setq astacklist (cons alist astacklist))
   (setq index (+ index 1))
 )
 (setq a (reverse astacklist))
 (setq a (vl-sort a (function (lambda (x1 x2)(< (car x1) (car x2))) ) ))

 (setq al (length a))
 (setq index 0)
 (setq aaa '())
 (repeat al
   (princ "\n; ")
   (princ index)
   (princ " - ")
   (princ (car (nth index a)))
   (princ " = ")
   (princ (cadr (nth index a)))
   (setq index (+ index 1))
 );end of repeat
);end of progn
);end of if
 (princ)
)

;; Unique  -  Lee Mac
;; Returns a list with duplicate elements removed.

(defun LM:Unique ( l )
    (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)

(princ "\n dxf compare loading complete")

 

thanks😆

Edited by exceed
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Still think much easier start with property list.

A line, pline etc has a  length so does an arc but a circle has circumference so it should appear on same line as length

 

Compare a line to a circle

 

; Length = 4.69019____________________________________________     ____________________________________________________________

 

; Length = 4.69019____________________________________________     ; Circumference 45.609_____________________________________

Edited by BIGAL
  • Like 1
Link to comment
Share on other sites
exceed Proficient

exceed

Posted
  • Author
Posted (edited)
4 hours ago, BIGAL said:

Still think much easier start with property list.

A line, pline etc has a  length so does an arc but a circle has circumference so it should appear on same line as length

 

Compare a line to a circle

 

; Length = 4.69019____________________________________________     ____________________________________________________________

 

; Length = 4.69019____________________________________________     ; Circumference 45.609_____________________________________

 

you pointed out for me the weak points very well. thanks a lot!

for now, as you said, only a routine is implemented that sorts properties in alphabetical order

then passes two if they are equal, or skip to next a or b index if not equal. just that is all. It's shameful to call it a compare...

 

the first thing to do is to find that this property is good compared to this property of other objects. I'll think about that.

 

also I think

1. it would be good to write the meaning of the assoc number for each object type in dxf compare. 

2. and like other text comparison sites, I was looking for a way to highlight text after finding another character inside an attribute string.(such as %%u underline or bold)

    like below

 

; Length = 4.69019____________________________________________     ; Length = 4.69223____________________________________________

 

    But it doesn't seem to be possible from the command prompt.

    so, I've been thinking about adding {, } before and after, or adding ★, but I'm stop that because it seems to be two much.

3. And if the property itself is vla-object in vla-object, it would be good to list and compare properties in application, database, document, hyperlinks, truecolor, etc.

   I tested that by (princ (vl-princ-to-string (vlax-dump-object (vlax-get obj 'Truecolor))))

   In this case, it seems that you need to sort by avoiding duplicate removal in the same way as true color-blue, truecolor-bookname by adding true color in front of it rather than sorting the whole thing.

like this vda 

;; dump - 2022.03.18 exceed
;; dc - dxf compare 
;; vda - vl-dump-object alternative, this will make list not only command prompt output
;; vdc - vl-dump-object compare

(defun c:dc (/ a b ss1 ent ss2 al bl atype btype index aaa bbb aa aaa bb bbb aaal bbbl aindex bindex aaaa bbbb r agap agapstr bgap bgapstr r )
  (setq a "") 
  (setq b "")
  (princ "\n select 1st object for compare")
  (if (setq ss1 (ssget "+.:E:S" ))
    (progn
      (foreach ent
        (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
        (setq a (entget ent '( "*")))
      );end of foreach
      (princ "\n select 2nd object for compare")
      (if (setq ss2 (ssget "+.:E:S" ))
        (progn 
          (foreach ent
            (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2)))
            (setq b (entget ent '( "*")))
          );end of foreach
          (setq al (length a))
          (setq bl (length b))
          (setq atype (cdr (assoc 0 a)))
          (setq btype (cdr (assoc 0 b)))
          (setq index 0)
          (setq aaa '())
          (setq bbb '())
          (repeat al
             (setq aa (nth index a))
             (if (not (member aa b))
                (progn 
                  (setq aaa (cons aa aaa))
                );end of progn
             );end of if
             (setq index (+ index 1))
          );end of repeat
          (setq aaa (reverse aaa))
          (setq index 0)
          (repeat bl
             (setq bb (nth index b))
             (if (not (member bb a))
                (progn 
                  (setq bbb (cons bb bbb))
                );end of progn
             );end of if
             (setq index (+ index 1))
          );end of repeat
          (setq bbb (reverse bbb))
          (setq aaal (length aaa))
          (setq bbbl (length bbb))
          (cond 
            ((= aaal bbbl) (setq cccl aaal))
            ((> aaal bbbl) (setq cccl aaal))
            ((< aaal bbbl) (setq cccl bbbl))
          );end of cond
          (setq aindex 0)
          (setq bindex 0)
          (repeat (+ aaal bbbl)
             (setq aaaa (nth aindex aaa))
             (setq bbbb (nth bindex bbb))
             (setq r '())

             (if (= aaaa nil) (setq aaaa (list 99999 "empty")))
             (if (= bbbb nil) (setq bbbb (list 99999 "empty")))
             (setq agap (- 30 (strlen (vl-princ-to-string aaaa)) ) )
             (setq agapstr "")
             (cond 
               ((< agap 0) (setq agap 0))
               ((= agap 0) (setq agap 0))
               ((> agap 0) 
                 (repeat agap 
                   (setq agapstr (strcat "_" agapstr))
                 )
               )
             )
             (setq bgap (- 30 (strlen (vl-princ-to-string bbbb)) ) )
             (setq bgapstr "")
             (cond 
               ((< bgap 0) (setq bgap 0))
               ((= bgap 0) (setq bgap 0))
               ((> bgap 0) 
                 (repeat bgap
                   (setq bgapstr (strcat "_" bgapstr))
                 )
               )
             )

             (cond
                ( (= (car aaaa) (car bbbb))
                  (progn
                    (if (and (= (car aaaa) 99999) (= (car bbbb) 99999))
                        (progn)
                        (progn 
                          (setq r (list (strcat (vl-princ-to-string aaaa) agapstr) "\t \t" (strcat (vl-princ-to-string bbbb) bgapstr)))
                          (princ "\n")
                          (princ r)
                          (setq aindex (+ aindex 1))
                          (setq bindex (+ bindex 1))
                        );end of progn
                     );enf of if
                  )
                )
                ((< (car aaaa) (car bbbb))
                   (progn
                     (setq r (list (strcat (vl-princ-to-string aaaa) agapstr) "\t \t" "______________________________"))
                     (princ "\n")
                     (princ r)
                     (setq aindex (+ aindex 1))
                   )
                 )
                ((> (car aaaa) (car bbbb))
                   (progn
                     (setq r (list "______________________________" "\t \t" (strcat (vl-princ-to-string bbbb) bgapstr)))
                     (princ "\n")
                     (princ r)
                     (setq bindex (+ bindex 1))
                   )
                 )
               );end of cond

          );end of repeat
        );end of progn
        (progn 
          ;(princ "\n please re-select")
          ;(c:dc)
        );end of progn
      );end of if
    );end of progn
    (progn 
      ;(princ "\n please re-select")
      ;(c:dc)
    )
  )




  ;(textscr)
  (princ)
)




(defun f:vla-getlist ()
(cond
(*vla-getlist*)
((setq *vla-getlist* (mapcar (function (lambda (x) (substr x 9)))
(vl-remove-if-not (function (lambda (x) (wcmatch (strcase x) "VLA-GET-*"))) (atoms-family 1))
)
);setq
)
)
)

(defun f:vl-property-available (en)
(setq en (f:enx en))
(vl-remove-if-not (function (lambda (x) (vlax-property-available-p en x)))
(f:vla-getlist)
)
)

(defun f:vla-methodlist ()
(cond
(*vla-methodlist*)
((setq *vla-methodlist* (mapcar (function (lambda (x) (substr x 5)))
(vl-remove-if-not (function (lambda (x)
(and
(wcmatch (strcase x) "VLA-*")
(not (wcmatch (strcase x) "VLA-GET-*,VLA-PUT-*"))
);and
)
)
(atoms-family 1)
)
)
);setq
)
);cond
)



(defun f:vl-method-applicable (en)
(setq en (f:enx en))
(vl-remove-if-not (function (lambda (x) (vlax-method-applicable-p en x)))
(f:vla-methodlist)
)
)

(defun f:enx (en)
(if (= (type en) 'ENAME)
(vlax-ename->vla-object en)
en
)
)


(defun c:vdc ( / *error* ent astacklist aget al index aa aaa obj test alist a_txt a_hyp a ent2 bstacklist bget bl bb bbb obj2 test2 blist b_txt b_hyp b atype btype aaal bbbl aindex bindex aaaa bbbb agap agapstr bgap bgapstr )
  ;error control
    (defun *error* ( msg )
        ;(LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (princ)
    )
(princ "\n select 1st object for compare")
(if (setq ent (car (entsel)))
 (progn
 (setq astacklist '())
 (setq aget (f:vl-property-available ent))
 (setq aget (LM:Unique aget))
 (setq al (length aget))
 (setq index 0)
 ;(princ "\n a - ")
 ;(princ a)
 ;(princ "\n al - ")
 ;(princ al)
 (repeat al
   (setq aa (nth index aget)) 
   (setq aaa "")
   ;(princ "\n ")
   ;(princ (+ index 1))
   ;(princ " ")
   ;(princ aa)
   (setq obj (vlax-ename->vla-object ent))
   (if (vl-catch-all-error-p (setq test (vl-catch-all-apply (function vlax-get) (list obj aa))))
                (progn 
                   ;(princ (vl-catch-all-error-message test)) ;print error message
                   (setq aaa " ")
                   ;(princ " - ")
                   ;(princ aaa)
                );end of progn
                (progn 
                   (setq aaa (vl-princ-to-string (vlax-get obj aa)))
                   ;(princ " - ")
                   ;(princ aaa)
                 );end of progn
   );end of if
   (setq alist '())
   (setq alist (list (strcat (substr aa 1 1) (strcase (substr aa 2) t)) aaa))
   (setq astacklist (cons alist astacklist))
   (setq index (+ index 1))
 )
 (setq a_txt "")
 (setq a_hyp (vlax-get-property obj 'Hyperlinks))
 (vlax-for each a_hyp
	(setq a_txt (strcat (vla-get-url each)))
 )
 (setq alist (list "Hyperlinks-URL" a_txt))
 (setq astacklist (cons alist astacklist))

 (setq a (reverse astacklist))
 (princ "\n select 2nd object for compare")

(if (setq ent2 (car (entsel)))
 (progn
 (setq bstacklist '())
 (setq bget (f:vl-property-available ent2))
 (setq bget (LM:Unique bget))
 (setq bl (length bget))
 (setq index 0)
 ;(princ "\n b - ")
 ;(princ b)
 ;(princ "\n bl - ")
 ;(princ bl)
 (repeat bl
   (setq bb (nth index bget)) 
   (setq bbb "")
   ;(princ "\n ")
   ;(princ (+ index 1))
   ;(princ " ")
   ;(princ bb)
   (setq obj2 (vlax-ename->vla-object ent2))
   (if (vl-catch-all-error-p (setq test2 (vl-catch-all-apply (function vlax-get) (list obj2 bb))))
                (progn 
                   ;(princ (vl-catch-all-error-message test2)) ;print error message
                   (setq bbb " ")
                   ;(princ " - ")
                   ;(princ bbb)
                );end of progn
                (progn 
                   (setq bbb (vl-princ-to-string (vlax-get obj2 bb)))
                   ;(princ " - ")
                   ;(princ bbb)
                 );end of progn
   );end of if
   (setq blist '())
   (setq blist (list (strcat (substr bb 1 1) (strcase (substr bb 2) t)) bbb))
   (setq bstacklist (cons blist bstacklist))
   (setq index (+ index 1))
 )
 (setq b_txt "")
 (setq b_hyp (vlax-get-property obj2 'Hyperlinks))
 (vlax-for each b_hyp
	(setq b_txt (strcat (vla-get-url each)))
 )
 (setq blist (list "Hyperlinks-URL" b_txt))
 (setq bstacklist (cons blist bstacklist))

 (setq b (reverse bstacklist))




 (setq a (vl-sort a (function (lambda (x1 x2)(< (car x1) (car x2))) ) ))
 (setq b (vl-sort b (function (lambda (x1 x2)(< (car x1) (car x2))) ) ))

          (setq al (length a))
          (setq bl (length b))
          (setq atype (cdr (assoc 0 a)))
          (setq btype (cdr (assoc 0 b)))
          (setq index 0)
          (setq aaa '())
          (setq bbb '())
          (repeat al
             (setq aa (nth index a))
             (if (not (member aa b))
                (progn 
                  (setq aaa (cons aa aaa))
                );end of progn
             );end of if
             (setq index (+ index 1))
          );end of repeat
          (setq aaa (reverse aaa))
          (setq index 0)
          (repeat bl
             (setq bb (nth index b))
             (if (not (member bb a))
                (progn 
                  (setq bbb (cons bb bbb))
                );end of progn
             );end of if
             (setq index (+ index 1))
          );end of repeat
          (setq bbb (reverse bbb))
          (setq aaal (length aaa))
          (setq bbbl (length bbb))
          (cond 
            ((= aaal bbbl) (setq cccl aaal))
            ((> aaal bbbl) (setq cccl aaal))
            ((< aaal bbbl) (setq cccl bbbl))
          );end of cond
          (setq aindex 0)
          (setq bindex 0)
          (repeat (+ aaal bbbl)
             (setq aaaa (nth aindex aaa))
             (setq bbbb (nth bindex bbb))
             (setq r '())

             (if (= aaaa nil) (setq aaaa (list "ZZZZZ" "empty")))
             (if (= bbbb nil) (setq bbbb (list "ZZZZZ" "empty")))
             (setq agap (- 60 (strlen (vl-princ-to-string aaaa)) ) )
             (setq agapstr "")
             (cond 
               ((< agap 0) (setq agap 0))
               ((= agap 0) (setq agap 0))
               ((> agap 0) 
                 (repeat agap 
                   (setq agapstr (strcat "_" agapstr))
                 )
               )
             )
             (setq bgap (- 60 (strlen (vl-princ-to-string bbbb)) ) )
             (setq bgapstr "")
             (cond 
               ((< bgap 0) (setq bgap 0))
               ((= bgap 0) (setq bgap 0))
               ((> bgap 0) 
                 (repeat bgap
                   (setq bgapstr (strcat "_" bgapstr))
                 )
               )
             )

             (cond
                ( (= (car aaaa) (car bbbb))
                  (progn
                    (if (and (= (car aaaa) "ZZZZZ") (= (car bbbb) "ZZZZZ"))
                        (progn)
                        (progn 
                          (setq r (list aaaa "\t \t" bbbb))
                          (princ "\n ; ")
                          (princ (car (car r)))
                          (princ " = ")
                          (princ (cadr (car r)))
                          (princ agapstr)
                          (princ (cadr r)) 
                          (princ "; ")
                          (princ (car (caddr r)))
                          (princ " = ")
                          (princ (cadr (caddr r)))
                          (princ bgapstr)
                          (setq aindex (+ aindex 1))
                          (setq bindex (+ bindex 1))
                        );end of progn
                     );enf of if
                  )
                )
                ((< (car aaaa) (car bbbb))
                   (progn
                     (setq r (list aaaa "\t \t" "____________________________________________________________"))
                          (princ "\n ; ")
                          (princ (car (car r)))
                          (princ " = ")
                          (princ (cadr (car r)))
                          (princ agapstr)
                          (princ (cadr r))
                          (princ "; ")
                          (princ (caddr r))
                     (setq aindex (+ aindex 1))
                   )
                 )
                ((> (car aaaa) (car bbbb))
                   (progn
                     (setq r (list "____________________________________________________________" "\t \t" bbbb))
                          (princ "\n ; ")
                          (princ (car r))
                          (princ (cadr r))
                          (princ "; ")
                          (princ (car (caddr r)))
                          (princ " = ")
                          (princ (cadr (caddr r)))
                          (princ bgapstr)
                     (setq bindex (+ bindex 1))
                   )
                 )
               );end of cond

          );end of repeat
        );end of progn
        (progn 
          ;(princ "\n please re-select")
          ;(c:dc)
        );end of progn
      );end of if
    );end of progn
    (progn 
      ;(princ "\n please re-select")
      ;(c:dc)
    )
  )
 (princ)
)



; vl-dump-object alternative
(defun c:vda ( / *error* a astacklist ent aget al index aa aaa obj test obj asubget asubl asubindex aaasub aasub asub2get asub2l asub2index aasub2 aaasub2 asub2list astacklist asublist alist a )
  ;error control
    (defun *error* ( msg )
        ;(LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (princ)
    )
(princ "\n select object for dump")
(setq a '())
(setq astacklist '())
(if (setq ent (car (entsel)))
 (progn
 (setq aget (f:vl-property-available ent))
 (setq aget (LM:Unique aget))
 (setq al (length aget))
 (setq index 0)
 (repeat al
   (setq aa (nth index aget)) 
   (setq aaa "")
   (setq obj (vlax-ename->vla-object ent))
   (if (vl-catch-all-error-p (setq test (vl-catch-all-apply (function vlax-get) (list obj aa))))
                (progn 
                   ;(princ (vl-catch-all-error-message test)) ;print error message
                   (setq aaa " ")
                );end of progn
                (progn 
                   (if (and (/= (vl-princ-to-string aa) "DOCUMENT") (/= (vl-princ-to-string aa) "APPLICATION") (/= (vl-princ-to-string aa) "DATABASE"))
                     (progn
                       (setq aaa (vlax-get obj aa))
                   ;(princ (type aaa))
                       (if (= (type obj) (type aaa))
                       (progn 
                           (setq asubget (f:vl-property-available aaa))
                           (setq asubget (LM:Unique asubget))
                           (setq asubl (length asubget))
                           (setq asubindex 0)
                           (repeat asubl
                              (setq aasub (nth asubindex asubget)) 
                              (setq aaasub "")
                              (if (vl-catch-all-error-p (setq subtest (vl-catch-all-apply (function vlax-get) (list aaa aasub))))
                                 (progn 
                                   ;(princ (vl-catch-all-error-message subtest)) ;print error message
                                    (setq aaasub " ")
                                 );end of progn
                                 (progn 
                                    (setq aaasub (vlax-get aaa aasub))
                                    (if (and (= (type obj) (type aaasub)) (/= (vl-princ-to-string aasub) "DOCUMENT") (/= (strcase (vl-princ-to-string aasub)) "APPLICATION") (/= (vl-princ-to-string aasub) "DATABASE"))
                                        (progn
                                          (setq asub2get (f:vl-property-available aaasub))
                                          (setq asub2get (LM:Unique asub2get))
                                          (setq asub2l (length asub2get))
                                          (setq asub2index 0)
                                          (repeat asub2l
                                             (setq aasub2 (nth asub2index asub2get)) 
                                             (setq aaasub2 "")
                                             (if (vl-catch-all-error-p (setq sub2test (vl-catch-all-apply (function vlax-get) (list aaasub aasub2))))
                                               (progn 
                                                 ;(princ (vl-catch-all-error-message sub2test)) ;print error message
                                                 (setq aaasub2 " ")
                                               );end of progn
                                               (progn                                            
                                                 (setq aaasub2 (vl-princ-to-string (vlax-get aaasub aasub2)))
                                               )
                                             );end of if
                                             (setq asub2list '())                                             
                                             (setq asub2list (list (strcat (substr aa 1 1) (strcase (substr aa 2) t) "-" (substr aasub 1 1) (strcase (substr aasub 2) t) "-" (substr aasub2 1 1) (strcase (substr aasub2 2) t)) aaasub2))
                                             (setq astacklist (cons asub2list astacklist))
                                             (setq asub2index (+ asub2index 1))
                                           );end of repeat
                                         );end of progn
                                         (progn
                                           (setq aaasub (vl-princ-to-string (vlax-get aaa aasub)))
                                         );end of progn
                                   );end of if



                                 );end of progn
                              );end of if
                              (setq asublist '())
                              (setq asublist (list (strcat (substr aa 1 1) (strcase (substr aa 2) t) "-" (substr aasub 1 1) (strcase (substr aasub 2) t)) aaasub))
                              (setq astacklist (cons asublist astacklist))
                              (setq asubindex (+ asubindex 1))
                            );end of repeat

                              ;(princ "\n asubstacklist - ")
                              ;(princ asubstacklist) 
                         );end of progn
                         (progn
                            (setq aaa (vl-princ-to-string (vlax-get obj aa)))
                         );end of progn
                     );end of if
                   );progn
                   (progn
                     (setq aaa (vl-princ-to-string (vlax-get obj aa)))
                   );progn
                 );end of if
               );end of progn
   );end of if


   (setq alist '())
   (setq alist (list (strcat (substr aa 1 1) (strcase (substr aa 2) t)) aaa))
   (setq astacklist (cons alist astacklist))
   (setq index (+ index 1))
 )

 (setq a_hyp (vlax-get-property obj 'Hyperlinks))
 (vlax-for each a_hyp
	(setq a_txt (strcat (vla-get-url each)))
 )

 (setq alist (list "Hyperlinks-URL" a_txt))
 (setq astacklist (cons alist astacklist))

 (setq a (reverse astacklist))
 (setq a (vl-sort a (function (lambda (x1 x2)(< (car x1) (car x2))) ) ))

 (setq al (length a))
 (setq index 0)
 (setq aaa '())
 (repeat al
   (princ "\n; ")
   (princ index)
   (princ " - ")
   (princ (car (nth index a)))
   (princ " = ")
   (princ (cadr (nth index a)))
   (setq index (+ index 1))
 );end of repeat
);end of progn
);end of if
 (princ)
)

;; Unique  -  Lee Mac
;; Returns a list with duplicate elements removed.

(defun LM:Unique ( l )
    (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)

(princ "\n dc, vdc, vda - loading complete")

By modifying c:VDA to output up to step 2, (not VDC)

it is now possible to immediately see the internal value of true color.

 

I tried the same method for hyperlink, but a different method was needed,

so I artificially added the Hyperlinks-URL item. Because I enjoy using hyperlinks   

 

 

😀

Edited by exceed
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

There is another post trying to find it again by Andrea and a routine called "entgui" it shows all the detail of an entity even down the rabbit hole with block attributes, I posted a PM but no return.

  • Like 1
Link to comment
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
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.

×
 Share
Go to topic listing
×
×
  • Create New...