Jump to content

Decimal points in compare points lisp


russ079

Recommended Posts

Hi,

I've have been searching for a lisp to compare co orindates of x y z points. There are only a handful I could find, attached is the closest to what I need. I want to make a couple of tweaks to it, I have made simple lisps before and modified a couple but am I struggling following the code in this one.

 

Firstly I work in mm and the text output in this lisp doesn't show a decimal point , 5mm is shown as 5000. Can anyone advise what i need to chasnge me how to make it display as 5.0 ?

A  + or - symbol would be nice as well. I've been playing with the rtos but can't manage to make it work.

 

Secondly it puts text in for the delta x and delta y, how can I add a 3rd line showing delta z ?

 

Thanks Russ

 

 

compare.LSP

Link to comment
Share on other sites

3.14159265359Need a sample drawing

 

Quote

5mm is shown as 5000

 

Units is set to mm but stuff was drawn in M need to scale everything down 1:1000

 

Quote

A  + or - symbol would be nice as well.

 

Assume positive (+) if it doesn't have the negative symbol it just complicates things if your doing calculations.

 

rtos = (rtos number [mode [precision]]) 

(setq x 3.14159265359) ;set x as a real number

(setq string (rtos x 2 5)) ; first number sets the mode to Decimal the 2nd number means how many decimal places you want to see

string = "3.14159"

Link to comment
Share on other sites

Please see attached drawing and screen shot. White point is 0,0,0 & purple point 5.0,7.5,10. And it is show as 5000 & 7500 as screen shot. I have check my units in drawing, and it does the same whichever units & presision are set.

 

 

 

 

 

compare points.dwgCapture.thumb.PNG.d4d86a926913aa273f83e6664fc1c3a6.PNG

Link to comment
Share on other sites

As I can see here is the issue 

 

(command "-INSERT" blnam "_S" cmp:scal inpt "0" (rtos (abs (* (car  deval) 1000)) 2 0) (rtos (abs (* (cadr  deval) 1000)) 2 0))

It multiply by 1000

It shall be 

(command "-INSERT" blnam "_S" cmp:scal inpt "0" (rtos (abs (* (car  deval) 1.000)) 2 0) (rtos (abs (* (cadr  deval) 1.000)) 2 0))

Multiply by 1 

 

Link to comment
Share on other sites

There are other issues 

 

[CHECKING TEXT compare.LSP loading... SELECTION]
.
; warning: local variable used as function: SS2LIST
; warning: local variable used as function: SS2LIST
; error: too few arguments in SETQ: (SETQ APP (MAPCAR ( ... ) APL) APD ... )
; Check done.

 

and what does it mean this  2  ** at 

 

(setq app (mapcar '(lambda (a) (trans (cdr (assoc 10 (entget a))) 0 1)) apl)
               apd (mapcar '(lambda (a) (distance a pth)) app)
               pta (nth (vl-position (apply 'min apd) apd) app)
             deval (mapcar '- pta pth)
                xp (car pta) yp (cadr pta)
                xb (car pth) yb (cadr pth)
              inpt (polar pth 0 cmp:off)
             blnam (cond
                      ((and (<= xp xb) (<  yp yb)) "Compare_RT")
                      ((and (>= xp xb) (>  yp yb)) "Compare_LB")
                      ((and (<  xp xb) (>= yp yb)) "Compare_RB")
                      ((and (>  xp xb) (<= yp yb)) "Compare_LT")
                   )
             **  (command "-INSERT" blnam "_S" cmp:scal inpt "0" (rtos (abs (* (car  deval) 1.000)) 2 0) (rtos (abs (* (cadr  deval) 1.000)) 2 0))
         )
                                            
                                            ** is a reserved funtion multiply 
                                            

 

 

 

 

**  (command "-INSERT" blnam "_S" cmp:scal inpt "0" (rtos (abs (* (car  deval) 1.000)) 2 0) (rtos (abs (* (cadr  deval) 1.000)) 2 0))

 

  • Like 1
Link to comment
Share on other sites

Thanks Devitg, I will give it a go tomorrow with  changing the multipler. Any ideas how to add the delta z ? I think the selection is reading z values but there's no output

Link to comment
Share on other sites

1 hour ago, russ079 said:

Thanks Devitg, I will give it a go tomorrow with  changing the multipler. Any ideas how to add the delta z ? I think the selection is reading z values but there's no output

You will need to add the att  Delta  z to each block 

image.png.182083519167370c60117a12e9dad688.png

 

 

 

 

 

 

 

Link to comment
Share on other sites

I change the multipliers from 1000 to 1.000 and also changed the precision from 0 to 1 and that is bit is working good now, Thank you.

 

I have added lines to the in the set block function for the delta z.  This works in the block, but prompts me to type in the z value. I cant see the link from the block attribute to where it getting its information from - theres no Dx or Delta x in the rest of the script

 

;; This section Entmake's the "ROMAN" style and the 4 required blocks on loading the routine.
(defun setblocks ()
   (mapcar 'entmakex
        (list   
          '((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "ROMANS") (3 . "txt.shx") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0)) 
   
          '((0 . "BLOCK") (67 . 0) (8 . "0") (2 . "Compare_LB") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -0.10 1.35 0) (11 1.35 1.35 0))
          '((0 . "SOLID")  (67 . 0) (8 . "Compare_Tags")  (10 0.57 1.22 0) (11 0.57 1.47 0) (12 -0.10 1.35 0) (13 -0.10 1.35 0) (39 . 0))
          '((0 . "SOLID") (67 . 0) (8 . "Compare_Tags") (10 1.47 0.57 0) (11 1.22 0.57 0) (12 1.35 -0.10 0) (13 1.35 -0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 1.35 -0.10 0) (11 1.35 1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK"))

          '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Compare_LT") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -0.10 -1.35 0) (11 1.35 -1.35 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 0.57 -1.22 0) (11 0.57 -1.47 0) (12 -0.10 -1.35 0) (13 -0.10 -1.35 0) (39 . 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 1.47 -0.57 0) (11 1.22 -0.57 0) (12 1.35 0.10 0) (13 1.35 0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 1.35 0.10 0) (11 1.35 -1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 -1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35  1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))

          '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Compare_RB") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 0.10 1.35 0) (11 -1.35 1.35 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -0.57 1.22 0) (11 -0.57 1.47 0) (12 0.10 1.35 0)   (13 0.10 1.35 0)   (39 . 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -1.47 0.57 0) (11 -1.22 0.57 0) (12 -1.35 -0.10 0) (13 -1.35 -0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -1.35 -0.10 0) (11 -1.35 1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35  1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 -1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))

          '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Compare_RT") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 0.10 -1.35 0) (11 -1.35 -1.35 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -0.57 -1.22 0) (11 -0.57 -1.47 0) (12 0.10 -1.35 0) (13 0.10 -1.35 0) (39 . 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -1.47 -0.57 0) (11 -1.22 -0.57 0) (12 -1.35 0.10 0) (13 -1.35 0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -1.35 0.10 0) (11 -1.35 -1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35 -1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35  1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))
        )
   )
)


(princ (strcat "Compare " cmpversion " Loaded!...Type compare or cmp to Run."))
(princ)2023-01-21.thumb.png.fa3f43a156991444090fab70c1d33804.png

Capture.PNG

Link to comment
Share on other sites

First Use the <> buttion in the header when posting code.

 

Quote

I have added lines to the in the set block function for the delta z.  This works in the block, but prompts me to type in the z value. I cant see the link from the block attribute to where it getting its information from - theres no Dx or Delta x in the rest of the script

 

looks good. but if something isn't working right create the block or point how you want and then use this lisp from CAB.

http://www.theswamp.org/index.php?topic=31145

 

When inserting a block with attributes it asks for their inputs by defualt. So you should just need to update the insert command to add the Dz.

 

(  x       y        z   )

(car cadr caddr)

 

**  (command "-INSERT" blnam "_S" cmp:scal inpt "0" "Dx Att" "Dy Att" "Dz Att")

Code below
**  (command "-INSERT" blnam "_S" cmp:scal inpt "0" (rtos (abs (* (car  deval) 1.0)) 2 0) (rtos (abs (* (cadr  deval) 1.0)) 2 0) (rtos (abs (* (caddr  deval) 1.0)) 2 0))

 

-edit

 

just need 1.0

Edited by mhupp
Link to comment
Share on other sites

As you suggested just adding the Dz to the insert command has worked, and the lisp is working pretty much as i need now, except the "dz" does not show a minus symbol when its required. Ive has a search but couldn't find anything. Do you have any ideas why it wouldnt be showing ?

Also is it possible to add pretext to the caddr valve, I just wanted to put a "H" before it.

 

Thanks again for your help.

Link to comment
Share on other sites

;; compare.lsp Version 1.0    by ymg         November 2015                    ;
;;                                                                            ;
;; Derived from deviation.lsp by ASMI                                         ;
;;                                                                            ;
;; User select an entity on a layer deemed the theoretical position           ;
;; he also selects an entity on another layer considered as-built position    ;
;;                                                                            ;
;; Programs then compare Theoretical vs As-Built and annotate each position   ;
;;                                                                            ;
;; Notes:                                                                     ;
;;                                                                            ;
;; The necessary style and blocks are created upon running this lisp.         ;
;; No need for separate drawings for these blocks.                            ;
;;                                                                            ;
;; The default values for Search Aperture is 0.25 unit. This gives a search   ;
;; box of 0.50 x 0.50 units.  Be careful in setting this value as too big     ;
;; a value might confuse the program when an entity does not have a           ;
;; corresponding As-Built entity.  Furthermore it will slows the comparison.  ;
;;                                                                            ;
;; Tag Scale default is 0.2, giving a bounding box of 0.9 x 0.9 units         ;
;; Adjust it to fit your drawing.                                             ;
;;                                                                            ;
;; Tag Offset is at 0.6 unit away from theoretical point by default.          ;
;;                                                                            ;

(setq cmpversion "V1.0")

(defun c:cmp () (c:compare))
(defun c:compare ( / ** *acdoc* a abl apd apl app  deval aben abent then thent errcnt
                     abflt thflt inpt blnam oldcol oldoff oldsapr oldscal pt pta pth spol
                      varl xb xp yb yp *error* ss2list)
   
   (vl-load-com)   
   
   (or *acdoc*  (setq *acdoc*  (vla-get-ActiveDocument (vlax-get-acad-object))))
   
   (defun *error* (msg)
      (mapcar 'eval varl)
      (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
         (princ (strcat "\nError: " msg))
      )
      (vla-endundomark *acdoc*)
      (princ)
   )


   ;;                                                                         ;
   ;; mk_lwp    by Alan J Thompson     (Modified by ymg for closed poly)      ;
   ;;                                                                         ;
   ;; Argument: pl, A list of points (2d or 3d)                               ;
   ;; Create an LWPolyline at Elevation 0, on Current Layer.                  ;
   ;; Return: Polyline Entity Name                                            ;
   ;;                                                                         ;

   (defun mk_lwp (pl / isclosed)
      (setq isclosed 0)
      (if (equal (car pl) (last pl) 0.001)
         (setq isclosed 1 pl (cdr pl))
      )  
   
      (entmakex
         (append (list '(0 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbPolyline")
                        (cons 90 (length pl))
                        (cons 70 isclosed)
                 )
                 (mapcar '(lambda (p) (cons 10 (trans (list (car p) (cadr p)) 1 0))) pl)
         )
      )
   )


   

   ;;                                                                         ;
   ;; bbpoint                                                                 ;
   ;;                                                                         ;
   ;; Returns:  Bounding Box of a List of Points as a List of 2 Items         ;
   ;;           ((minx miny minz) (maxx maxy maxz))                           ;
   ;;                                                                         ;

   (defun bbpoint (l)
      (list (apply 'mapcar (cons 'min l)) (apply 'mapcar (cons 'max l)))
   )  
   

   ;;                                                                         ;
   ;;  Convert selection set to list of ename or vla objects                  ;
   ;;     ss - SSGET selection set                                            ;
   ;;   mode - T for vla objects, nil for ename                               ;
   ;;  Alan J. Thompson, 04.20.09                                             ;
   ;;                                                                         ;

   (defun ss2list (ss mode / l)
      (and ss
           (setq l (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
           mode
           (setq l (mapcar 'vlax-ename->vla-object l))
      )
      l
   )

   (setq thent (entget (car (entsel "\nPick an Entity on Theoretical Layer: ")))
         abent (entget (car (entsel "\nPick an Entity on As-Built Layer: ")))
         thtyp (assoc 0 thent) 
         thlay (assoc 8 thent)
         abtyp (assoc 0 abent)
         ablay (assoc 8 abent) 
         thflt (list thtyp thlay)
         abflt (list abtyp ablay)
          thl (mapcar '(lambda (a) (trans (cdr (assoc 10 (entget a))) 0 1))
                             (ss2list (ssget "_A" thflt) nil)
              )         
        thnum (length thl)
        abnum (sslength  (ssget "_A" abflt))
       errcnt 0
   )
   
   (or cmp:sapr (setq cmp:sapr 25))
   (or cmp:scal (setq cmp:scal 5))
   (or cmp:off  (setq cmp:off  5))
   
   (setq oldscal cmp:scal  oldoff  cmp:off oldsapr cmp:sapr)
   
   (setq cmp:sapr (getreal (strcat "\nSpecify Search Aperture <" (rtos cmp:sapr) ">: ")))
   (or cmp:sapr (setq cmp:sapr oldsapr))

   (setq dist (sqrt (* 2.0 (* cmp:sapr cmp:sapr)))
         spol (list
                 (polar '(0 0) (* 0.25 pi) dist)
                 (polar '(0 0) (* 0.75 pi) dist)
                 (polar '(0 0) (* 1.25 pi) dist)
                 (polar '(0 0) (* 1.75 pi) dist)
              )
           bb (bbpoint thl)
           zb (list
                 (mapcar '- (car  bb) (list cmp:sapr cmp:sapr))
                 (mapcar '+ (cadr bb) (list cmp:sapr cmp:sapr))
				 (mapcar '- (caddr bb) (list cmp:sapr cmp:sapr))
              )   
   )
         
   (setq cmp:scal (getreal (strcat "\nSpecify tags scale <" (rtos cmp:scal) ">: ")))
   (or cmp:scal (setq cmp:scal oldscal))
   
   (setq cmp:off (getdist (strcat "\nSpecify point-tag offset distance <" (rtos cmp:off)  ">: ")))
   (or cmp:off (setq cmp:off oldoff))

   (vla-startundomark *acdoc*)

   (setq varl '("CMDECHO" "OSMODE" "ATTDIA" "ATTREQ" "PDSIZE" "INSUNITS")
         varl   (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) varl)
   )
   
   (setvar 'OSMODE 0)
   (setvar 'ATTREQ 1)
   (setvar 'ATTDIA 0)
   (setvar 'CMDECHO 0)
   (setvar 'PDSIZE 0.15)
   (setvar 'INSUNITS 0)

   (setblocks) ; Must be called after setting INSUNITS to 0                   ;

   (acet-ui-progress "ComparinG:"  thnum)
   
   (foreach pth thl
      (command "_ZOOM" "_W" (car zb) (cadr zb))
      (setq apl (ss2list
                   (ssget "_CP" (setq wind (mapcar '(lambda (a) (mapcar '+ pth a)) spol)) abflt)
                    nil
                )
      )
            
      (if apl
         (setq app (mapcar '(lambda (a) (trans (cdr (assoc 10 (entget a))) 0 1)) apl)
               apd (mapcar '(lambda (a) (distance a pth)) app)
               pta (nth (vl-position (apply 'min apd) apd) app)
             deval (mapcar '- pta pth)
                xp (car pta) yp (cadr pta)
                xb (car pth) yb (cadr pth)
              inpt (polar pth 0 cmp:off)
             blnam (cond
                      ((and (<= xp xb) (<  yp yb)) "Compare_RT")
                      ((and (>= xp xb) (>  yp yb)) "Compare_LB")
                      ((and (<  xp xb) (>= yp yb)) "Compare_RB")
                      ((and (>  xp xb) (<= yp yb)) "Compare_LT")
                   )
				** (command "-INSERT" blnam "_S" cmp:scal inpt "0" (rtos (abs (* (car  deval) 1.0)) 2 1) (rtos (abs (* (cadr  deval) 1.0)) 2 1) (rtos (abs (* (caddr  deval) 1.0)) 2 1)
         )
         (progn
            (setq errcnt (1+ errcnt)
                  oldcol   (getvar "CECOLOR")
            )
            (setvar "CECOLOR" "1")
            (mk_lwp (cons (last wind) wind))   ;(command "_.circle" pth cmp:off)
            (setvar "CECOLOR" oldcol)
         )
      )
      (acet-ui-progress -1)
   )
   
   (acet-ui-progress)
   (setq notpaired (- thnum abnum errcnt))
   (alert
      (strcat "\n   Compare " cmpversion 
              "\n\n   " (itoa thnum) " " (cdr thtyp) " Entities on Theoretical Layer: " (cdr thlay) 
              "\n\n   " (itoa abnum) " " (cdr abtyp) " Entities on As-Built Layer   : " (cdr ablay)
              (if (zerop notpaired)
                 "\n\n   All Entities Were Paired During Search Phase."
                 (strcat "\n\n   " (itoa notpaired) " Entities Could Not Be Paired During Search Phase.")
              )   
              "\n\n   Entities Not Paired Or Missing, On As-Built Layer, Are Highlighted"
              "\n   With Red Squares, Same Size As Search Aperture."
      )
   )
     
   (*error* nil)
)
   
;; This section Entmake's the "ROMAN" style and the 4 required blocks on loading the routine.
(defun setblocks ()
   (mapcar 'entmakex
        (list   
          '((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "ROMANS") (3 . "txt.shx") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0)) 
   
          '((0 . "BLOCK") (67 . 0) (8 . "0") (2 . "Compare_LB") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -0.10 1.35 0) (11 1.35 1.35 0))
          '((0 . "SOLID")  (67 . 0) (8 . "Compare_Tags")  (10 0.57 1.22 0) (11 0.57 1.47 0) (12 -0.10 1.35 0) (13 -0.10 1.35 0) (39 . 0))
          '((0 . "SOLID") (67 . 0) (8 . "Compare_Tags") (10 1.47 0.57 0) (11 1.22 0.57 0) (12 1.35 -0.10 0) (13 1.35 -0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 1.35 -0.10 0) (11 1.35 1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -1.35 0) (74 . 2))
		  '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK"))

          '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Compare_LT") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -0.10 -1.35 0) (11 1.35 -1.35 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 0.57 -1.22 0) (11 0.57 -1.47 0) (12 -0.10 -1.35 0) (13 -0.10 -1.35 0) (39 . 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 1.47 -0.57 0) (11 1.22 -0.57 0) (12 1.35 0.10 0) (13 1.35 0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 1.35 0.10 0) (11 1.35 -1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 -1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35  1.35 0) (74 . 2))
		  '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))

          '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Compare_RB") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 0.10 1.35 0) (11 -1.35 1.35 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -0.57 1.22 0) (11 -0.57 1.47 0) (12 0.10 1.35 0)   (13 0.10 1.35 0)   (39 . 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -1.47 0.57 0) (11 -1.22 0.57 0) (12 -1.35 -0.10 0) (13 -1.35 -0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -1.35 -0.10 0) (11 -1.35 1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35  1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 -1.35 0) (74 . 2))
		  '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))

          '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Compare_RT") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 0.10 -1.35 0) (11 -1.35 -1.35 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -0.57 -1.22 0) (11 -0.57 -1.47 0) (12 0.10 -1.35 0) (13 0.10 -1.35 0) (39 . 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -1.47 -0.57 0) (11 -1.22 -0.57 0) (12 -1.35 0.10 0) (13 -1.35 0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -1.35 0.10 0) (11 -1.35 -1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35 -1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35  1.35 0) (74 . 2))
		  '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))
        )
   )
)


(princ (strcat "Compare " cmpversion " Loaded!...Type compare or cmp to Run."))
(princ)

 

Link to comment
Share on other sites

17 hours ago, russ079 said:
;; compare.lsp Version 1.0    by ymg         November 2015                    ;
;;                                                                            ;
;; Derived from deviation.lsp by ASMI                                         ;
;;                                                                            ;
;; User select an entity on a layer deemed the theoretical position           ;
;; he also selects an entity on another layer considered as-built position    ;
;;                                                                            ;
;; Programs then compare Theoretical vs As-Built and annotate each position   ;
;;                                                                            ;
;; Notes:                                                                     ;
;;                                                                            ;
;; The necessary style and blocks are created upon running this lisp.         ;
;; No need for separate drawings for these blocks.                            ;
;;                                                                            ;
;; The default values for Search Aperture is 0.25 unit. This gives a search   ;
;; box of 0.50 x 0.50 units.  Be careful in setting this value as too big     ;
;; a value might confuse the program when an entity does not have a           ;
;; corresponding As-Built entity.  Furthermore it will slows the comparison.  ;
;;                                                                            ;
;; Tag Scale default is 0.2, giving a bounding box of 0.9 x 0.9 units         ;
;; Adjust it to fit your drawing.                                             ;
;;                                                                            ;
;; Tag Offset is at 0.6 unit away from theoretical point by default.          ;
;;                                                                            ;

(setq cmpversion "V1.0")

(defun c:cmp () (c:compare))
(defun c:compare ( / ** *acdoc* a abl apd apl app  deval aben abent then thent errcnt
                     abflt thflt inpt blnam oldcol oldoff oldsapr oldscal pt pta pth spol
                      varl xb xp yb yp *error* ss2list)
   
   (vl-load-com)   
   
   (or *acdoc*  (setq *acdoc*  (vla-get-ActiveDocument (vlax-get-acad-object))))
   
   (defun *error* (msg)
      (mapcar 'eval varl)
      (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
         (princ (strcat "\nError: " msg))
      )
      (vla-endundomark *acdoc*)
      (princ)
   )


   ;;                                                                         ;
   ;; mk_lwp    by Alan J Thompson     (Modified by ymg for closed poly)      ;
   ;;                                                                         ;
   ;; Argument: pl, A list of points (2d or 3d)                               ;
   ;; Create an LWPolyline at Elevation 0, on Current Layer.                  ;
   ;; Return: Polyline Entity Name                                            ;
   ;;                                                                         ;

   (defun mk_lwp (pl / isclosed)
      (setq isclosed 0)
      (if (equal (car pl) (last pl) 0.001)
         (setq isclosed 1 pl (cdr pl))
      )  
   
      (entmakex
         (append (list '(0 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbPolyline")
                        (cons 90 (length pl))
                        (cons 70 isclosed)
                 )
                 (mapcar '(lambda (p) (cons 10 (trans (list (car p) (cadr p)) 1 0))) pl)
         )
      )
   )


   

   ;;                                                                         ;
   ;; bbpoint                                                                 ;
   ;;                                                                         ;
   ;; Returns:  Bounding Box of a List of Points as a List of 2 Items         ;
   ;;           ((minx miny minz) (maxx maxy maxz))                           ;
   ;;                                                                         ;

   (defun bbpoint (l)
      (list (apply 'mapcar (cons 'min l)) (apply 'mapcar (cons 'max l)))
   )  
   

   ;;                                                                         ;
   ;;  Convert selection set to list of ename or vla objects                  ;
   ;;     ss - SSGET selection set                                            ;
   ;;   mode - T for vla objects, nil for ename                               ;
   ;;  Alan J. Thompson, 04.20.09                                             ;
   ;;                                                                         ;

   (defun ss2list (ss mode / l)
      (and ss
           (setq l (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
           mode
           (setq l (mapcar 'vlax-ename->vla-object l))
      )
      l
   )

   (setq thent (entget (car (entsel "\nPick an Entity on Theoretical Layer: ")))
         abent (entget (car (entsel "\nPick an Entity on As-Built Layer: ")))
         thtyp (assoc 0 thent) 
         thlay (assoc 8 thent)
         abtyp (assoc 0 abent)
         ablay (assoc 8 abent) 
         thflt (list thtyp thlay)
         abflt (list abtyp ablay)
          thl (mapcar '(lambda (a) (trans (cdr (assoc 10 (entget a))) 0 1))
                             (ss2list (ssget "_A" thflt) nil)
              )         
        thnum (length thl)
        abnum (sslength  (ssget "_A" abflt))
       errcnt 0
   )
   
   (or cmp:sapr (setq cmp:sapr 25))
   (or cmp:scal (setq cmp:scal 5))
   (or cmp:off  (setq cmp:off  5))
   
   (setq oldscal cmp:scal  oldoff  cmp:off oldsapr cmp:sapr)
   
   (setq cmp:sapr (getreal (strcat "\nSpecify Search Aperture <" (rtos cmp:sapr) ">: ")))
   (or cmp:sapr (setq cmp:sapr oldsapr))

   (setq dist (sqrt (* 2.0 (* cmp:sapr cmp:sapr)))
         spol (list
                 (polar '(0 0) (* 0.25 pi) dist)
                 (polar '(0 0) (* 0.75 pi) dist)
                 (polar '(0 0) (* 1.25 pi) dist)
                 (polar '(0 0) (* 1.75 pi) dist)
              )
           bb (bbpoint thl)
           zb (list
                 (mapcar '- (car  bb) (list cmp:sapr cmp:sapr))
                 (mapcar '+ (cadr bb) (list cmp:sapr cmp:sapr))
				 (mapcar '- (caddr bb) (list cmp:sapr cmp:sapr))
              )   
   )
         
   (setq cmp:scal (getreal (strcat "\nSpecify tags scale <" (rtos cmp:scal) ">: ")))
   (or cmp:scal (setq cmp:scal oldscal))
   
   (setq cmp:off (getdist (strcat "\nSpecify point-tag offset distance <" (rtos cmp:off)  ">: ")))
   (or cmp:off (setq cmp:off oldoff))

   (vla-startundomark *acdoc*)

   (setq varl '("CMDECHO" "OSMODE" "ATTDIA" "ATTREQ" "PDSIZE" "INSUNITS")
         varl   (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) varl)
   )
   
   (setvar 'OSMODE 0)
   (setvar 'ATTREQ 1)
   (setvar 'ATTDIA 0)
   (setvar 'CMDECHO 0)
   (setvar 'PDSIZE 0.15)
   (setvar 'INSUNITS 0)

   (setblocks) ; Must be called after setting INSUNITS to 0                   ;

   (acet-ui-progress "ComparinG:"  thnum)
   
   (foreach pth thl
      (command "_ZOOM" "_W" (car zb) (cadr zb))
      (setq apl (ss2list
                   (ssget "_CP" (setq wind (mapcar '(lambda (a) (mapcar '+ pth a)) spol)) abflt)
                    nil
                )
      )
            
      (if apl
         (setq app (mapcar '(lambda (a) (trans (cdr (assoc 10 (entget a))) 0 1)) apl)
               apd (mapcar '(lambda (a) (distance a pth)) app)
               pta (nth (vl-position (apply 'min apd) apd) app)
             deval (mapcar '- pta pth)
                xp (car pta) yp (cadr pta)
                xb (car pth) yb (cadr pth)
              inpt (polar pth 0 cmp:off)
             blnam (cond
                      ((and (<= xp xb) (<  yp yb)) "Compare_RT")
                      ((and (>= xp xb) (>  yp yb)) "Compare_LB")
                      ((and (<  xp xb) (>= yp yb)) "Compare_RB")
                      ((and (>  xp xb) (<= yp yb)) "Compare_LT")
                   )
				** (command "-INSERT" blnam "_S" cmp:scal inpt "0" (rtos (abs (* (car  deval) 1.0)) 2 1) (rtos (abs (* (cadr  deval) 1.0)) 2 1) (rtos (abs (* (caddr  deval) 1.0)) 2 1)
         )
         (progn
            (setq errcnt (1+ errcnt)
                  oldcol   (getvar "CECOLOR")
            )
            (setvar "CECOLOR" "1")
            (mk_lwp (cons (last wind) wind))   ;(command "_.circle" pth cmp:off)
            (setvar "CECOLOR" oldcol)
         )
      )
      (acet-ui-progress -1)
   )
   
   (acet-ui-progress)
   (setq notpaired (- thnum abnum errcnt))
   (alert
      (strcat "\n   Compare " cmpversion 
              "\n\n   " (itoa thnum) " " (cdr thtyp) " Entities on Theoretical Layer: " (cdr thlay) 
              "\n\n   " (itoa abnum) " " (cdr abtyp) " Entities on As-Built Layer   : " (cdr ablay)
              (if (zerop notpaired)
                 "\n\n   All Entities Were Paired During Search Phase."
                 (strcat "\n\n   " (itoa notpaired) " Entities Could Not Be Paired During Search Phase.")
              )   
              "\n\n   Entities Not Paired Or Missing, On As-Built Layer, Are Highlighted"
              "\n   With Red Squares, Same Size As Search Aperture."
      )
   )
     
   (*error* nil)
)
   
;; This section Entmake's the "ROMAN" style and the 4 required blocks on loading the routine.
(defun setblocks ()
   (mapcar 'entmakex
        (list   
          '((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "ROMANS") (3 . "txt.shx") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0)) 
   
          '((0 . "BLOCK") (67 . 0) (8 . "0") (2 . "Compare_LB") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -0.10 1.35 0) (11 1.35 1.35 0))
          '((0 . "SOLID")  (67 . 0) (8 . "Compare_Tags")  (10 0.57 1.22 0) (11 0.57 1.47 0) (12 -0.10 1.35 0) (13 -0.10 1.35 0) (39 . 0))
          '((0 . "SOLID") (67 . 0) (8 . "Compare_Tags") (10 1.47 0.57 0) (11 1.22 0.57 0) (12 1.35 -0.10 0) (13 1.35 -0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 1.35 -0.10 0) (11 1.35 1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -1.35 0) (74 . 2))
		  '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK"))

          '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Compare_LT") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -0.10 -1.35 0) (11 1.35 -1.35 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 0.57 -1.22 0) (11 0.57 -1.47 0) (12 -0.10 -1.35 0) (13 -0.10 -1.35 0) (39 . 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 1.47 -0.57 0) (11 1.22 -0.57 0) (12 1.35 0.10 0) (13 1.35 0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 1.35 0.10 0) (11 1.35 -1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 -1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35  1.35 0) (74 . 2))
		  '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))

          '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Compare_RB") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 0.10 1.35 0) (11 -1.35 1.35 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -0.57 1.22 0) (11 -0.57 1.47 0) (12 0.10 1.35 0)   (13 0.10 1.35 0)   (39 . 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -1.47 0.57 0) (11 -1.22 0.57 0) (12 -1.35 -0.10 0) (13 -1.35 -0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -1.35 -0.10 0) (11 -1.35 1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35  1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35 -1.35 0) (74 . 2))
		  '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))

          '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Compare_RT") (10 0 0 0) (70 . 2))
          '((0 . "LINE") (8 . "Compare_Tags") (10 0.10 -1.35 0) (11 -1.35 -1.35 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -0.57 -1.22 0) (11 -0.57 -1.47 0) (12 0.10 -1.35 0) (13 0.10 -1.35 0) (39 . 0))
          '((0 . "SOLID") (100 . "AcDbEntity") (67 . 0) (8 . "Compare_Tags") (100 . "AcDbTrace") (10 -1.47 -0.57 0) (11 -1.22 -0.57 0) (12 -1.35 0.10 0) (13 -1.35 0.10 0) (39 . 0))
          '((0 . "LINE") (8 . "Compare_Tags") (10 -1.35 0.10 0) (11 -1.35 -1.35 0))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 -1.50 1.35 0) (1 . "00") (2 . "Dx") (3 . "Delta x") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11  1.35 -1.35 0) (74 . 2))
          '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -1.50 0) (1 . "00") (2 . "Dy") (3 . "Delta y") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 -1.35  1.35 0) (74 . 2))
		  '((0 . "ATTDEF") (8 . "Compare_Values") (10 1.35 -4.50 0) (1 . "00") (2 . "Dz") (3 . "Delta z") (40 . 1.5) (50 . 0) (41 . 0.7) (51 . 0) (7 . "ROMANS") (70 . 0) (71 . 0) (72 . 1) (11 1.35 -3.35 0) (74 . 2))
          '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))
        )
   )
)


(princ (strcat "Compare " cmpversion " Loaded!...Type compare or cmp to Run."))
(princ)

 

hi 

 

error: malformed list on input

Link to comment
Share on other sites

Was missing a few ")"

 

the Arrows in the block points to the direction of the x and y offset. They are always going to be positive values. changed it so the Z is either positive or negative. sorry for the delay.

 

compare.lsp

Edited by mhupp
Link to comment
Share on other sites

  • 1 month later...

Thats what I use at the minute, but i can only see the results in the command line. I world like them displayed in a block with arrows. The compare.lsp works good when I have 2 points but some times I want use 1 point and a centre of a circle or a corner of a square. The drawings can start to get messy when I have to add lots points so I can put the deviation arrows in.

 

I will try and have a look this evening, see if I can figure out how the compare lisp is making the arrows & block and modify it to use results from the distance command.

 

I found the below code on https://www.afralisp.net, I just need to work out how to display the results in a block with arrows.

 

;get a reference to the Utilities Object :

(setq util (vla-get-utility 
                   (vla-get-activedocument 
                        (vlax-get-acad-object))))
                        
(setq dist (vla-getdistance util nil "\nFirst Point : \n"))

(setq dist (vla-getdistance util PT1 "\nSecond Point : \n"))

 

 

 

 

Capture.PNG

Edited by russ079
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.

×
×
  • Create New...