Jump to content

Help me to fix an AutoCAD lisp to work with GstarCAD

mhy3sx

By mhy3sx
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

  • Replies 25
  • Created
  • Last Reply

Top Posters In This Topic

  • mhy3sx

    16

  • BIGAL

    7

  • Steven P

    2

  • exceed

    1

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

mhy3sx
mhy3sx

Hi BIGAL, I don't know how to fix this code.  Is easy to find getpropertyvalue in notepad , but to replace with what? In GstarCAD lisp some commands is missing   Can you fix this code?

BIGAL
BIGAL

(setq str (getpropertyvalue (car blklist) "POINT")); the first one this returns the attribute value with the tag name matching "POINT" (setq str (strcat str " - " (getpropertyvalue blk "POINT"))) thi

Posted Images

mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted

Hi BIGAL. Is not 0.

 

I use this code by default to set the scale

  

( DEFUN C:SETSC ()
  (setvar "OSMODE" 13)
  (setq cursc (getvar "useri1" ))
  (princ "\nThe Scale is 1:")(princ cursc)
  (setq newsc (getint "\nNew scale is  1:"))
  (setvar "useri1" newsc)
  (princ)
)

 

Link to comment
Share on other sites
  • 2 weeks later...
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted (edited)

Hi BIGAL. I did all the changes but is not working. I get

  

Error: syntax error

 

Can you check the code?

For the scale i use  this code

  

( DEFUN C:SETSC ()
  (setvar "OSMODE" 13)
  (setq cursc (getvar "useri1" ))
  (princ "\nThe Scale is 1:")(princ cursc)
  (setq newsc (getint "\nNew scale is  1:"))
  (setvar "useri1" newsc)
  (princ)
)

 

 

But I work in Layout the most of the times

  

(defun aH:getatt (blk tagn)
(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
(princ)
)

(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)
(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]


(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))


;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq
      (repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
     ;(setq str (getpropertyvalue (car blklist) "POINT")); the first one
	  (ah:getatt (car blklist) "POINT")) ; the first one
      (foreach blk (cdr blklist); the rest
     ;(setq str (strcat str " - " (getpropertyvalue blk "POINT")))
	  (setq str (strcat str " - " (ah:getatt blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " τ.μ."))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )



    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if

;==============================================================================================

    (setq SS (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL"))))
		(repeat (setq i (sslength SS))
			(setq ent (ssname SS (setq i (1- i))))
			(setq vla-obj (vlax-ename->vla-object ent))
			(if 
				(and
					(or
						(not (= (vla-get-XScaleFactor vla-obj) scf))
						(not (= (vla-get-YScaleFactor vla-obj) scf))
						(not (= (vla-get-ZScaleFactor vla-obj) scf))
					)
					(vlax-property-available-p vla-obj 'EffectiveName)
				)
				(progn
					(vla-put-XScaleFactor vla-obj scf)
					(vlax-put-property vla-obj 'YScaleFactor scf)
					(vlax-put vla-obj 'ZScaleFactor scf)
	                 	)
		    )
		);repeat
		(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
	(princ)

;==============================================================================================

;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

 

And the version with scale blocks when i select the first point gives me the error

  

Error: invalid argument type: stringp:

 

  

(defun aH:getatt (blk tagn)
(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
(princ)
)

(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)
(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]

;=======================Change block scale 0.01(incase some block is too close) =================
;(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))
;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
;(setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
;=================================================================================================

;================================= first change Steven P ================================================

(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))

;;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
  (setq BlkEnt (entget (ssname blkss 0)))
  (setq BlkScales (list (assoc 41 BlkEnt) (assoc 42 BlkEnt) (assoc 43 BlkEnt))) 

  (setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
  (foreach blkent blklistall
    (setq ed (entget blkent))
    (setq ed (subst (cons 41 0.1) (assoc 41 ed) ed )) ; x scale
    (setq ed (subst (cons 42 0.1) (assoc 42 ed) ed )) ; y scale
    (setq ed (subst (cons 43 0.1) (assoc 43 ed) ed )) ; z scale
    (entmod ed)
  )

;================================================================================================


;;;;----;;;;
(princ "\nOK To Here, No. 1")
;;;;----;;;;




;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq



;;;;----;;;;
(princ "\nOK To Here, No. 2")
;;;;----;;;;

(repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
      ;(setq str (getpropertyvalue (car blklist) "POINT")); the first one
	  (ah:getatt (car blklist) "POINT")) ; the first one
      (foreach blk (cdr blklist); the rest
      ;(setq str (strcat str " - " (getpropertyvalue blk "POINT")))
	  (setq str (strcat str " - " (ah:getatt blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " τ.μ."))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )

;=============================== Recover scale ============================================

   ;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" blkscl)) ;  second change Steven P 

;==============================================================================================

    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if

;==============================================================================================

    (setq SS (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL"))))
		(repeat (setq i (sslength SS))
			(setq ent (ssname SS (setq i (1- i))))
			(setq vla-obj (vlax-ename->vla-object ent))
			(if 
				(and
					(or
						(not (= (vla-get-XScaleFactor vla-obj) scf))
						(not (= (vla-get-YScaleFactor vla-obj) scf))
						(not (= (vla-get-ZScaleFactor vla-obj) scf))
					)
					(vlax-property-available-p vla-obj 'EffectiveName)
				)
				(progn
					(vla-put-XScaleFactor vla-obj scf)
					(vlax-put-property vla-obj 'YScaleFactor scf)
					(vlax-put vla-obj 'ZScaleFactor scf)
	                 	)
		    )
		);repeat
		(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
	(princ)

;==============================================================================================

;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

 

Any ideas?

 

Thanks

Edited by mhy3sx
Link to comment
Share on other sites
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted

I update the code. Now insert the text but the numbers are random and with wrong angle !!!

  

;(defun aH:getatt (blk tagn)
;(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
;(foreach att atts
;(if (= (vla-get-tagstring att) tagn)
;(setq str (vla-get-textstring att))
;)
;)
;(princ)
;)

(defun aH:getatt (blk tagn / atts str)
(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
str
)


(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)
(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]


(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))


;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq
      (repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
     ;(setq str (getpropertyvalue (car blklist) "POINT")); the first one
	  (setq str (ah:getatt (car blklist) "POINT")) ; the first one
      (foreach blk (cdr blklist); the rest
     ;(setq str (strcat str " - " (getpropertyvalue blk "POINT")))
	  (setq str (strcat str " - " (ah:getatt blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " sq.m"))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )



    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if



;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

 

1.jpg

Link to comment
Share on other sites
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted

I update this line

  

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )

 

with

  

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 100 str ""
        "_.move" "_last" "" "@" pause
      )

 

The text is correct but vertical !!!! How to fix the code to insert the text correct? Any ideas?

 

Thanks

test2.jpg

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